1#!perl 2 3BEGIN { 4 unshift @INC, 't'; 5 require Config; 6 if (($Config::Config{'extensions'} !~ /\bB\b/) ){ 7 print "1..0 # Skip -- Perl configured without B module\n"; 8 exit 0; 9 } 10 if (!$Config::Config{useperlio}) { 11 print "1..0 # Skip -- need perlio to walk the optree\n"; 12 exit 0; 13 } 14} 15 16use OptreeCheck; # ALSO DOES @ARGV HANDLING !!!!!! 17use Config; 18 19plan tests => 67; 20 21################################# 22 23use constant { # see also t/op/gv.t line 282 24 myaref => [ 1,2,3 ], 25 myfl => 1.414213, 26 myglob => \*STDIN, 27 myhref => { a => 1 }, 28 myint => 42, 29 myrex => qr/foo/, 30 mystr => 'hithere', 31 mysub => \&ok, 32 myundef => undef, 33 myunsub => \&nosuch, 34}; 35 36sub myyes() { 1==1 } 37sub myno () { return 1!=1 } 38sub pi () { 3.14159 }; 39 40my $RV_class = $] >= 5.011 ? 'IV' : 'RV'; 41 42my $want = { # expected types, how value renders in-line, todos (maybe) 43 mystr => [ 'PV', '"'.mystr.'"' ], 44 myhref => [ $RV_class, '\\\\HASH'], 45 pi => [ 'NV', pi ], 46 myglob => [ $RV_class, '\\\\' ], 47 mysub => [ $RV_class, '\\\\' ], 48 myunsub => [ $RV_class, '\\\\' ], 49 # these are not inlined, at least not per BC::Concise 50 #myyes => [ $RV_class, ], 51 #myno => [ $RV_class, ], 52 myaref => [ $RV_class, '\\\\' ], 53 myfl => [ 'NV', myfl ], 54 myint => [ 'IV', myint ], 55 $] >= 5.011 ? ( 56 myrex => [ $RV_class, '\\\\"\\(?^:Foo\\)"' ], 57 ) : ( 58 myrex => [ $RV_class, '\\\\' ], 59 ), 60 myundef => [ 'NULL', ], 61}; 62 63use constant WEEKDAYS 64 => qw ( Sunday Monday Tuesday Wednesday Thursday Friday Saturday ); 65 66 67$::{napier} = \2.71828; # counter-example (doesn't get optimized). 68eval "sub napier ();"; 69 70 71# should be able to undefine constant::import here ??? 72INIT { 73 # eval 'sub constant::import () {}'; 74 # undef *constant::import::{CODE}; 75}; 76 77################################# 78pass("RENDER CONSTANT SUBS RETURNING SCALARS"); 79 80for $func (sort keys %$want) { 81 # no strict 'refs'; # why not needed ? 82 checkOptree ( name => "$func() as a coderef", 83 code => \&{$func}, 84 noanchors => 1, 85 expect => <<EOT_EOT, expect_nt => <<EONT_EONT); 86 is a constant sub, optimized to a $want->{$func}[0] 87EOT_EOT 88 is a constant sub, optimized to a $want->{$func}[0] 89EONT_EONT 90 91} 92 93pass("RENDER CALLS TO THOSE CONSTANT SUBS"); 94 95for $func (sort keys %$want) { 96 # print "# doing $func\n"; 97 checkOptree ( name => "call $func", 98 code => "$func", 99 ($want->{$func}[2]) ? ( todo => $want->{$func}[2]) : (), 100 bc_opts => '-nobanner', 101 expect => <<EOT_EOT, expect_nt => <<EONT_EONT); 1023 <1> leavesub[2 refs] K/REFC,1 ->(end) 103- <\@> lineseq KP ->3 1041 <;> dbstate(main 833 (eval 44):1) v ->2 1052 <\$> const[$want->{$func}[0] $want->{$func}[1]] s* ->3 < 5.017002 1062 <\$> const[$want->{$func}[0] $want->{$func}[1]] s*/FOLD ->3 >=5.017002 107EOT_EOT 1083 <1> leavesub[2 refs] K/REFC,1 ->(end) 109- <\@> lineseq KP ->3 1101 <;> dbstate(main 833 (eval 44):1) v ->2 1112 <\$> const($want->{$func}[0] $want->{$func}[1]) s* ->3 < 5.017002 1122 <\$> const($want->{$func}[0] $want->{$func}[1]) s*/FOLD ->3 >=5.017002 113EONT_EONT 114 115} 116 117############## 118pass("MORE TESTS"); 119 120checkOptree ( name => 'myyes() as coderef', 121 code => sub () { 1==1 }, 122 noanchors => 1, 123 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 124 is a constant sub, optimized to a SPECIAL 125EOT_EOT 126 is a constant sub, optimized to a SPECIAL 127EONT_EONT 128 129 130checkOptree ( name => 'myyes() as coderef', 131 prog => 'sub a() { 1==1 }; print a', 132 noanchors => 1, 133 strip_open_hints => 1, 134 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 135# 6 <@> leave[1 ref] vKP/REFC ->(end) 136# 1 <0> enter ->2 137# 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3 138# 5 <@> print vK ->6 139# 3 <0> pushmark s ->4 140# 4 <$> const[SPECIAL sv_yes] s* ->5 < 5.017002 141# 4 <$> const[SPECIAL sv_yes] s*/FOLD ->5 >=5.017002 142EOT_EOT 143# 6 <@> leave[1 ref] vKP/REFC ->(end) 144# 1 <0> enter ->2 145# 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3 146# 5 <@> print vK ->6 147# 3 <0> pushmark s ->4 148# 4 <$> const(SPECIAL sv_yes) s* ->5 < 5.017002 149# 4 <$> const(SPECIAL sv_yes) s*/FOLD ->5 >=5.017002 150EONT_EONT 151 152 153# Need to do this as a prog, not code, as only the first constant to use 154# PL_sv_no actually gets to use the real thing - every one following is 155# copied. 156checkOptree ( name => 'myno() as coderef', 157 prog => 'sub a() { 1!=1 }; print a', 158 noanchors => 1, 159 strip_open_hints => 1, 160 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 161# 6 <@> leave[1 ref] vKP/REFC ->(end) 162# 1 <0> enter ->2 163# 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3 164# 5 <@> print vK ->6 165# 3 <0> pushmark s ->4 166# 4 <$> const[SPECIAL sv_no] s* ->5 < 5.017002 167# 4 <$> const[SPECIAL sv_no] s*/FOLD ->5 >=5.017002 168EOT_EOT 169# 6 <@> leave[1 ref] vKP/REFC ->(end) 170# 1 <0> enter ->2 171# 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3 172# 5 <@> print vK ->6 173# 3 <0> pushmark s ->4 174# 4 <$> const(SPECIAL sv_no) s* ->5 < 5.017002 175# 4 <$> const(SPECIAL sv_no) s*/FOLD ->5 >=5.017002 176EONT_EONT 177 178 179my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT'); 180# 3 <1> leavesub[2 refs] K/REFC,1 ->(end) 181# - <@> lineseq K ->3 182# 1 <;> nextstate(constant 61 constant.pm:118) v:*,&,x*,x&,x$ ->2 183# 2 <0> padav[@list:FAKE:m:96] ->3 184EOT_EOT 185# 3 <1> leavesub[2 refs] K/REFC,1 ->(end) 186# - <@> lineseq K ->3 187# 1 <;> nextstate(constant 61 constant.pm:118) v:*,&,x*,x&,x$ ->2 188# 2 <0> padav[@list:FAKE:m:71] ->3 189EONT_EONT 190 191 192checkOptree ( name => 'constant sub returning list', 193 code => \&WEEKDAYS, 194 noanchors => 1, 195 expect => $expect, expect_nt => $expect_nt); 196 197 198sub printem { 199 printf "myint %d mystr %s myfl %f pi %f\n" 200 , myint, mystr, myfl, pi; 201} 202 203my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT'); 204# 9 <1> leavesub[1 ref] K/REFC,1 ->(end) 205# - <@> lineseq KP ->9 206# 1 <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2 207# 8 <@> prtf sK ->9 208# 2 <0> pushmark sM ->3 209# 3 <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] sM ->4 < 5.017002 210# 4 <$> const[IV 42] sM* ->5 < 5.017002 211# 5 <$> const[PV "hithere"] sM* ->6 < 5.017002 212# 6 <$> const[NV 1.414213] sM* ->7 < 5.017002 213# 7 <$> const[NV 3.14159] sM* ->8 < 5.017002 214# 3 <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] sM/FOLD ->4 >= 5.017002 215# 4 <$> const[IV 42] sM*/FOLD ->5 >=5.017002 216# 5 <$> const[PV "hithere"] sM*/FOLD ->6 >=5.017002 217# 6 <$> const[NV 1.414213] sM*/FOLD ->7 >=5.017002 218# 7 <$> const[NV 3.14159] sM*/FOLD ->8 >=5.017002 219EOT_EOT 220# 9 <1> leavesub[1 ref] K/REFC,1 ->(end) 221# - <@> lineseq KP ->9 222# 1 <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2 223# 8 <@> prtf sK ->9 224# 2 <0> pushmark sM ->3 225# 3 <$> const(PV "myint %d mystr %s myfl %f pi %f\n") sM ->4 < 5.017002 226# 4 <$> const(IV 42) sM* ->5 < 5.017002 227# 5 <$> const(PV "hithere") sM* ->6 < 5.017002 228# 6 <$> const(NV 1.414213) sM* ->7 < 5.017002 229# 7 <$> const(NV 3.14159) sM* ->8 < 5.017002 230# 3 <$> const(PV "myint %d mystr %s myfl %f pi %f\n") sM/FOLD ->4 >= 5.017002 231# 4 <$> const(IV 42) sM*/FOLD ->5 >=5.017002 232# 5 <$> const(PV "hithere") sM*/FOLD ->6 >=5.017002 233# 6 <$> const(NV 1.414213) sM*/FOLD ->7 >=5.017002 234# 7 <$> const(NV 3.14159) sM*/FOLD ->8 >=5.017002 235EONT_EONT 236 237if($] < 5.015) { 238 s/M(?=\*? ->)//g for $expect, $expect_nt; 239} 240 241checkOptree ( name => 'call many in a print statement', 242 code => \&printem, 243 strip_open_hints => 1, 244 expect => $expect, expect_nt => $expect_nt); 245 246# test constant expression folding 247 248checkOptree ( name => 'arithmetic constant folding in print', 249 code => 'print 1+2+3', 250 strip_open_hints => 1, 251 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 252# 5 <1> leavesub[1 ref] K/REFC,1 ->(end) 253# - <@> lineseq KP ->5 254# 1 <;> nextstate(main 937 (eval 53):1) v ->2 255# 4 <@> print sK ->5 256# 2 <0> pushmark s ->3 257# 3 <$> const[IV 6] s ->4 < 5.017002 258# 3 <$> const[IV 6] s/FOLD ->4 >=5.017002 259EOT_EOT 260# 5 <1> leavesub[1 ref] K/REFC,1 ->(end) 261# - <@> lineseq KP ->5 262# 1 <;> nextstate(main 937 (eval 53):1) v ->2 263# 4 <@> print sK ->5 264# 2 <0> pushmark s ->3 265# 3 <$> const(IV 6) s ->4 < 5.017002 266# 3 <$> const(IV 6) s/FOLD ->4 >=5.017002 267EONT_EONT 268 269checkOptree ( name => 'string constant folding in print', 270 code => 'print "foo"."bar"', 271 strip_open_hints => 1, 272 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 273# 5 <1> leavesub[1 ref] K/REFC,1 ->(end) 274# - <@> lineseq KP ->5 275# 1 <;> nextstate(main 942 (eval 55):1) v ->2 276# 4 <@> print sK ->5 277# 2 <0> pushmark s ->3 278# 3 <$> const[PV "foobar"] s ->4 < 5.017002 279# 3 <$> const[PV "foobar"] s/FOLD ->4 >=5.017002 280EOT_EOT 281# 5 <1> leavesub[1 ref] K/REFC,1 ->(end) 282# - <@> lineseq KP ->5 283# 1 <;> nextstate(main 942 (eval 55):1) v ->2 284# 4 <@> print sK ->5 285# 2 <0> pushmark s ->3 286# 3 <$> const(PV "foobar") s ->4 < 5.017002 287# 3 <$> const(PV "foobar") s/FOLD ->4 >=5.017002 288EONT_EONT 289 290checkOptree ( name => 'boolean or folding', 291 code => 'print "foobar" if 1 or 0', 292 strip_open_hints => 1, 293 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 294# 5 <1> leavesub[1 ref] K/REFC,1 ->(end) 295# - <@> lineseq KP ->5 296# 1 <;> nextstate(main 942 (eval 55):1) v ->2 297# 4 <@> print sK ->5 298# 2 <0> pushmark s ->3 299# 3 <$> const[PV "foobar"] s ->4 300EOT_EOT 301# 5 <1> leavesub[1 ref] K/REFC,1 ->(end) 302# - <@> lineseq KP ->5 303# 1 <;> nextstate(main 942 (eval 55):1) v ->2 304# 4 <@> print sK ->5 305# 2 <0> pushmark s ->3 306# 3 <$> const(PV "foobar") s ->4 307EONT_EONT 308 309checkOptree ( name => 'lc*,uc*,gt,lt,ge,le,cmp', 310 code => sub { 311 $s = uc('foo.').ucfirst('bar.').lc('LOW.').lcfirst('LOW'); 312 print "a-lt-b" if "a" lt "b"; 313 print "b-gt-a" if "b" gt "a"; 314 print "a-le-b" if "a" le "b"; 315 print "b-ge-a" if "b" ge "a"; 316 print "b-cmp-a" if "b" cmp "a"; 317 print "a-gt-b" if "a" gt "b"; # should be suppressed 318 }, 319 strip_open_hints => 1, 320 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 321# r <1> leavesub[1 ref] K/REFC,1 ->(end) 322# - <@> lineseq KP ->r 323# 1 <;> nextstate(main 916 optree_constants.t:307) v:>,<,%,{ ->2 324# 4 <2> sassign vKS/2 ->5 325# 2 <$> const[PV "FOO.Bar.low.lOW"] s ->3 < 5.017002 326# 2 <$> const[PV "FOO.Bar.low.lOW"] s/FOLD ->3 >=5.017002 327# - <1> ex-rv2sv sKRM*/1 ->4 328# 3 <#> gvsv[*s] s ->4 329# 5 <;> nextstate(main 916 optree_constants.t:308) v:>,<,%,{ ->6 330# 8 <@> print vK ->9 331# 6 <0> pushmark s ->7 332# 7 <$> const[PV "a-lt-b"] s ->8 333# 9 <;> nextstate(main 916 optree_constants.t:309) v:>,<,%,{ ->a 334# c <@> print vK ->d 335# a <0> pushmark s ->b 336# b <$> const[PV "b-gt-a"] s ->c 337# d <;> nextstate(main 916 optree_constants.t:310) v:>,<,%,{ ->e 338# g <@> print vK ->h 339# e <0> pushmark s ->f 340# f <$> const[PV "a-le-b"] s ->g 341# h <;> nextstate(main 916 optree_constants.t:311) v:>,<,%,{ ->i 342# k <@> print vK ->l 343# i <0> pushmark s ->j 344# j <$> const[PV "b-ge-a"] s ->k 345# l <;> nextstate(main 916 optree_constants.t:312) v:>,<,%,{ ->m 346# o <@> print vK ->p 347# m <0> pushmark s ->n 348# n <$> const[PV "b-cmp-a"] s ->o 349# p <;> nextstate(main 916 optree_constants.t:313) v:>,<,%,{ ->q 350# q <$> const[PVNV 0] s/SHORT ->r < 5.017002 351# q <$> const[PVNV 0] s/FOLD,SHORT ->r >=5.017002 352EOT_EOT 353# r <1> leavesub[1 ref] K/REFC,1 ->(end) 354# - <@> lineseq KP ->r 355# 1 <;> nextstate(main 916 optree_constants.t:307) v:>,<,%,{ ->2 356# 4 <2> sassign vKS/2 ->5 357# 2 <$> const(PV "FOO.Bar.low.lOW") s ->3 < 5.017002 358# 2 <$> const(PV "FOO.Bar.low.lOW") s/FOLD ->3 >=5.017002 359# - <1> ex-rv2sv sKRM*/1 ->4 360# 3 <$> gvsv(*s) s ->4 361# 5 <;> nextstate(main 916 optree_constants.t:308) v:>,<,%,{ ->6 362# 8 <@> print vK ->9 363# 6 <0> pushmark s ->7 364# 7 <$> const(PV "a-lt-b") s ->8 365# 9 <;> nextstate(main 916 optree_constants.t:309) v:>,<,%,{ ->a 366# c <@> print vK ->d 367# a <0> pushmark s ->b 368# b <$> const(PV "b-gt-a") s ->c 369# d <;> nextstate(main 916 optree_constants.t:310) v:>,<,%,{ ->e 370# g <@> print vK ->h 371# e <0> pushmark s ->f 372# f <$> const(PV "a-le-b") s ->g 373# h <;> nextstate(main 916 optree_constants.t:311) v:>,<,%,{ ->i 374# k <@> print vK ->l 375# i <0> pushmark s ->j 376# j <$> const(PV "b-ge-a") s ->k 377# l <;> nextstate(main 916 optree_constants.t:312) v:>,<,%,{ ->m 378# o <@> print vK ->p 379# m <0> pushmark s ->n 380# n <$> const(PV "b-cmp-a") s ->o 381# p <;> nextstate(main 916 optree_constants.t:313) v:>,<,%,{ ->q 382# q <$> const(SPECIAL sv_no) s/SHORT ->r < 5.017002 383# q <$> const(SPECIAL sv_no) s/FOLD,SHORT ->r >=5.017002 384EONT_EONT 385 386checkOptree ( name => 'mixed constant folding, with explicit braces', 387 code => 'print "foo"."bar".(2+3)', 388 strip_open_hints => 1, 389 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 390# 5 <1> leavesub[1 ref] K/REFC,1 ->(end) 391# - <@> lineseq KP ->5 392# 1 <;> nextstate(main 977 (eval 28):1) v ->2 393# 4 <@> print sK ->5 394# 2 <0> pushmark s ->3 395# 3 <$> const[PV "foobar5"] s ->4 < 5.017002 396# 3 <$> const[PV "foobar5"] s/FOLD ->4 >=5.017002 397EOT_EOT 398# 5 <1> leavesub[1 ref] K/REFC,1 ->(end) 399# - <@> lineseq KP ->5 400# 1 <;> nextstate(main 977 (eval 28):1) v ->2 401# 4 <@> print sK ->5 402# 2 <0> pushmark s ->3 403# 3 <$> const(PV "foobar5") s ->4 < 5.017002 404# 3 <$> const(PV "foobar5") s/FOLD ->4 >=5.017002 405EONT_EONT 406 407__END__ 408 409=head NB 410 411Optimized constant subs are stored as bare scalars in the stash 412(package hash), which formerly held only GVs (typeglobs). 413 414But you cant create them manually - you cant assign a scalar to a 415stash element, and expect it to work like a constant-sub, even if you 416provide a prototype. 417 418This is a feature; alternative is too much action-at-a-distance. The 419following test demonstrates - napier is not seen as a function at all, 420much less an optimized one. 421 422=cut 423 424checkOptree ( name => 'not evertnapier', 425 code => \&napier, 426 noanchors => 1, 427 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 428 has no START 429EOT_EOT 430 has no START 431EONT_EONT 432 433 434