1*256a93a4Safresh1#!./perl 2*256a93a4Safresh1 3*256a93a4Safresh1BEGIN { 4*256a93a4Safresh1 chdir 't' if -d 't'; 5*256a93a4Safresh1 require './test.pl'; 6*256a93a4Safresh1 set_up_inc('../lib'); 7*256a93a4Safresh1 skip_all("need B, need full perl") if is_miniperl(); 8*256a93a4Safresh1} 9*256a93a4Safresh1 10*256a93a4Safresh1# Tests the new documented mechanism for determining the original type 11*256a93a4Safresh1# of an SV. 12*256a93a4Safresh1 13*256a93a4Safresh1plan tests => 16; 14*256a93a4Safresh1use strict; 15*256a93a4Safresh1use B qw(svref_2object SVf_IOK SVf_NOK SVf_POK); 16*256a93a4Safresh1 17*256a93a4Safresh1my $x = 10; 18*256a93a4Safresh1my $xobj = svref_2object(\$x); 19*256a93a4Safresh1is($xobj->FLAGS & (SVf_IOK | SVf_POK), SVf_IOK, "correct base flags on IV"); 20*256a93a4Safresh1 21*256a93a4Safresh1my $y = $x . ""; 22*256a93a4Safresh1 23*256a93a4Safresh1is($xobj->FLAGS & (SVf_IOK | SVf_POK), SVf_IOK, "POK not set on IV used as string"); 24*256a93a4Safresh1 25*256a93a4Safresh1$x = 1.0; 26*256a93a4Safresh1 27*256a93a4Safresh1is($xobj->FLAGS & (SVf_NOK | SVf_POK), SVf_NOK, "correct base flags on NV"); 28*256a93a4Safresh1 29*256a93a4Safresh1$y = $x . ""; 30*256a93a4Safresh1 31*256a93a4Safresh1is($xobj->FLAGS & (SVf_NOK | SVf_POK), SVf_NOK, "POK not set on NV used as string"); 32*256a93a4Safresh1 33*256a93a4Safresh1my $z = $x; 34*256a93a4Safresh1$x = $z; 35*256a93a4Safresh1 36*256a93a4Safresh1is($xobj->FLAGS & (SVf_NOK | SVf_POK), SVf_NOK, "POK not set on copy of NV used as string"); 37*256a93a4Safresh1 38*256a93a4Safresh1$x = "Inf" + 0; 39*256a93a4Safresh1 40*256a93a4Safresh1is($xobj->FLAGS & (SVf_NOK | SVf_POK), SVf_NOK, "correct base flags on Inf NV"); 41*256a93a4Safresh1 42*256a93a4Safresh1$y = $x . ""; 43*256a93a4Safresh1 44*256a93a4Safresh1is($xobj->FLAGS & (SVf_NOK | SVf_POK), SVf_NOK, "POK not set on Inf NV used as string"); 45*256a93a4Safresh1 46*256a93a4Safresh1$z = $x; 47*256a93a4Safresh1$x = $z; 48*256a93a4Safresh1 49*256a93a4Safresh1is($xobj->FLAGS & (SVf_NOK | SVf_POK), SVf_NOK, "POK not set on copy of Inf NV used as string"); 50*256a93a4Safresh1 51*256a93a4Safresh1$x = "-Inf" + 0; 52*256a93a4Safresh1 53*256a93a4Safresh1is($xobj->FLAGS & (SVf_NOK | SVf_POK), SVf_NOK, "correct base flags on -Inf NV"); 54*256a93a4Safresh1 55*256a93a4Safresh1$y = $x . ""; 56*256a93a4Safresh1 57*256a93a4Safresh1is($xobj->FLAGS & (SVf_NOK | SVf_POK), SVf_NOK, "POK not set on -Inf NV used as string"); 58*256a93a4Safresh1 59*256a93a4Safresh1$z = $x; 60*256a93a4Safresh1$x = $z; 61*256a93a4Safresh1 62*256a93a4Safresh1is($xobj->FLAGS & (SVf_NOK | SVf_POK), SVf_NOK, "POK not set on copy of -Inf NV used as string"); 63*256a93a4Safresh1 64*256a93a4Safresh1{ 65*256a93a4Safresh1 local $^W = 0; 66*256a93a4Safresh1 $x = "NaN" + 0; 67*256a93a4Safresh1} 68*256a93a4Safresh1 69*256a93a4Safresh1is($xobj->FLAGS & (SVf_NOK | SVf_POK), SVf_NOK, "correct base flags on NaN NV"); 70*256a93a4Safresh1 71*256a93a4Safresh1$y = $x . ""; 72*256a93a4Safresh1 73*256a93a4Safresh1is($xobj->FLAGS & (SVf_NOK | SVf_POK), SVf_NOK, "POK not set on NaN NV used as string"); 74*256a93a4Safresh1 75*256a93a4Safresh1$z = $x; 76*256a93a4Safresh1$x = $z; 77*256a93a4Safresh1 78*256a93a4Safresh1is($xobj->FLAGS & (SVf_NOK | SVf_POK), SVf_NOK, "POK not set on copy of NaN NV used as string"); 79*256a93a4Safresh1 80*256a93a4Safresh1$x = "10"; 81*256a93a4Safresh1is($xobj->FLAGS & (SVf_IOK | SVf_POK), SVf_POK, "correct base flags on PV"); 82*256a93a4Safresh1 83*256a93a4Safresh1$y = $x + 10; 84*256a93a4Safresh1 85*256a93a4Safresh1is($xobj->FLAGS & (SVf_IOK | SVf_POK), (SVf_IOK | SVf_POK), "POK still set on PV used as number"); 86