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} 15use OptreeCheck; 16use Config; 17plan tests => 42; 18 19pass("OPTIMIZER TESTS - VAR INITIALIZATION"); 20 21checkOptree ( name => 'sub {my $a}', 22 bcopts => '-exec', 23 code => sub {my $a}, 24 strip_open_hints => 1, 25 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 26# 1 <;> nextstate(main 45 optree.t:23) v:>,<,% 27# 2 <0> padsv[$a:45,46] M/LVINTRO 28# 3 <1> leavesub[1 ref] K/REFC,1 29EOT_EOT 30# 1 <;> nextstate(main 45 optree.t:23) v:>,<,% 31# 2 <0> padsv[$a:45,46] M/LVINTRO 32# 3 <1> leavesub[1 ref] K/REFC,1 33EONT_EONT 34 35checkOptree ( name => '-exec sub {my $a}', 36 bcopts => '-exec', 37 code => sub {my $a}, 38 strip_open_hints => 1, 39 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 40# 1 <;> nextstate(main 49 optree.t:52) v:>,<,% 41# 2 <0> padsv[$a:49,50] M/LVINTRO 42# 3 <1> leavesub[1 ref] K/REFC,1 43EOT_EOT 44# 1 <;> nextstate(main 49 optree.t:45) v:>,<,% 45# 2 <0> padsv[$a:49,50] M/LVINTRO 46# 3 <1> leavesub[1 ref] K/REFC,1 47EONT_EONT 48 49checkOptree ( name => 'sub {our $a}', 50 bcopts => '-exec', 51 code => sub {our $a}, 52 strip_open_hints => 1, 53 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 541 <;> nextstate(main 21 optree.t:47) v:>,<,% 552 <#> gvsv[*a] s/OURINTR 563 <1> leavesub[1 ref] K/REFC,1 57EOT_EOT 58# 1 <;> nextstate(main 51 optree.t:56) v:>,<,% 59# 2 <$> gvsv(*a) s/OURINTR 60# 3 <1> leavesub[1 ref] K/REFC,1 61EONT_EONT 62 63checkOptree ( name => 'sub {local $a}', 64 bcopts => '-exec', 65 code => sub {local $a}, 66 strip_open_hints => 1, 67 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 681 <;> nextstate(main 23 optree.t:57) v:>,<,%,{ 692 <#> gvsv[*a] s/LVINTRO 703 <1> leavesub[1 ref] K/REFC,1 71EOT_EOT 72# 1 <;> nextstate(main 53 optree.t:67) v:>,<,%,{ 73# 2 <$> gvsv(*a) s/LVINTRO 74# 3 <1> leavesub[1 ref] K/REFC,1 75EONT_EONT 76 77checkOptree ( name => 'my $a', 78 prog => 'my $a', 79 bcopts => '-basic', 80 strip_open_hints => 1, 81 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 82# 4 <@> leave[1 ref] vKP/REFC ->(end) 83# 1 <0> enter ->2 84# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3 85# 3 <0> padsv[$a:1,2] vM/LVINTRO ->4 86EOT_EOT 87# 4 <@> leave[1 ref] vKP/REFC ->(end) 88# 1 <0> enter ->2 89# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3 90# 3 <0> padsv[$a:1,2] vM/LVINTRO ->4 91EONT_EONT 92 93checkOptree ( name => 'our $a', 94 prog => 'our $a', 95 bcopts => '-basic', 96 strip_open_hints => 1, 97 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 984 <@> leave[1 ref] vKP/REFC ->(end) 991 <0> enter ->2 1002 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3 101- <1> ex-rv2sv vK/17 ->4 1023 <#> gvsv[*a] s/OURINTR ->4 103EOT_EOT 104# 4 <@> leave[1 ref] vKP/REFC ->(end) 105# 1 <0> enter ->2 106# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3 107# - <1> ex-rv2sv vK/17 ->4 108# 3 <$> gvsv(*a) s/OURINTR ->4 109EONT_EONT 110 111checkOptree ( name => 'local $a', 112 prog => 'local $a', 113 errs => ['Name "main::a" used only once: possible typo at -e line 1.'], 114 bcopts => '-basic', 115 strip_open_hints => 1, 116 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 1174 <@> leave[1 ref] vKP/REFC ->(end) 1181 <0> enter ->2 1192 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3 120- <1> ex-rv2sv vKM/129 ->4 1213 <#> gvsv[*a] s/LVINTRO ->4 122EOT_EOT 123# 4 <@> leave[1 ref] vKP/REFC ->(end) 124# 1 <0> enter ->2 125# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3 126# - <1> ex-rv2sv vKM/129 ->4 127# 3 <$> gvsv(*a) s/LVINTRO ->4 128EONT_EONT 129 130pass("MY, OUR, LOCAL, BOTH SUB AND MAIN, = undef"); 131 132checkOptree ( name => 'sub {my $a=undef}', 133 code => sub {my $a=undef}, 134 bcopts => '-basic', 135 strip_open_hints => 1, 136 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 1375 <1> leavesub[1 ref] K/REFC,1 ->(end) 138- <@> lineseq KP ->5 1391 <;> nextstate(main 641 optree_varinit.t:130) v:>,<,% ->2 1404 <2> sassign sKS/2 ->5 1412 <0> undef s ->3 1423 <0> padsv[$a:641,642] sRM*/LVINTRO ->4 143EOT_EOT 144# 5 <1> leavesub[1 ref] K/REFC,1 ->(end) 145# - <@> lineseq KP ->5 146# 1 <;> nextstate(main 641 optree_varinit.t:130) v:>,<,% ->2 147# 4 <2> sassign sKS/2 ->5 148# 2 <0> undef s ->3 149# 3 <0> padsv[$a:641,642] sRM*/LVINTRO ->4 150EONT_EONT 151 152checkOptree ( name => 'sub {our $a=undef}', 153 code => sub {our $a=undef}, 154 note => 'the global must be reset', 155 bcopts => '-basic', 156 strip_open_hints => 1, 157 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 1585 <1> leavesub[1 ref] K/REFC,1 ->(end) 159- <@> lineseq KP ->5 1601 <;> nextstate(main 26 optree.t:109) v:>,<,%,{ ->2 1614 <2> sassign sKS/2 ->5 1622 <0> undef s ->3 163- <1> ex-rv2sv sKRM*/17 ->4 1643 <#> gvsv[*a] s/OURINTR ->4 165EOT_EOT 166# 5 <1> leavesub[1 ref] K/REFC,1 ->(end) 167# - <@> lineseq KP ->5 168# 1 <;> nextstate(main 446 optree_varinit.t:137) v:>,<,%,{ ->2 169# 4 <2> sassign sKS/2 ->5 170# 2 <0> undef s ->3 171# - <1> ex-rv2sv sKRM*/17 ->4 172# 3 <$> gvsv(*a) s/OURINTR ->4 173EONT_EONT 174 175checkOptree ( name => 'sub {local $a=undef}', 176 code => sub {local $a=undef}, 177 note => 'local not used enough to bother', 178 bcopts => '-basic', 179 strip_open_hints => 1, 180 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 1815 <1> leavesub[1 ref] K/REFC,1 ->(end) 182- <@> lineseq KP ->5 1831 <;> nextstate(main 28 optree.t:122) v:>,<,%,{ ->2 1844 <2> sassign sKS/2 ->5 1852 <0> undef s ->3 186- <1> ex-rv2sv sKRM*/129 ->4 1873 <#> gvsv[*a] s/LVINTRO ->4 188EOT_EOT 189# 5 <1> leavesub[1 ref] K/REFC,1 ->(end) 190# - <@> lineseq KP ->5 191# 1 <;> nextstate(main 58 optree.t:141) v:>,<,%,{ ->2 192# 4 <2> sassign sKS/2 ->5 193# 2 <0> undef s ->3 194# - <1> ex-rv2sv sKRM*/129 ->4 195# 3 <$> gvsv(*a) s/LVINTRO ->4 196EONT_EONT 197 198checkOptree ( name => 'my $a=undef', 199 prog => 'my $a=undef', 200 bcopts => '-basic', 201 strip_open_hints => 1, 202 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 2036 <@> leave[1 ref] vKP/REFC ->(end) 2041 <0> enter ->2 2052 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3 2065 <2> sassign vKS/2 ->6 2073 <0> undef s ->4 2084 <0> padsv[$a:1,2] sRM*/LVINTRO ->5 209EOT_EOT 210# 6 <@> leave[1 ref] vKP/REFC ->(end) 211# 1 <0> enter ->2 212# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3 213# 5 <2> sassign vKS/2 ->6 214# 3 <0> undef s ->4 215# 4 <0> padsv[$a:1,2] sRM*/LVINTRO ->5 216EONT_EONT 217 218checkOptree ( name => 'our $a=undef', 219 prog => 'our $a=undef', 220 note => 'global must be reassigned', 221 bcopts => '-basic', 222 strip_open_hints => 1, 223 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 2246 <@> leave[1 ref] vKP/REFC ->(end) 2251 <0> enter ->2 2262 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3 2275 <2> sassign vKS/2 ->6 2283 <0> undef s ->4 229- <1> ex-rv2sv sKRM*/17 ->5 2304 <#> gvsv[*a] s/OURINTR ->5 231EOT_EOT 232# 6 <@> leave[1 ref] vKP/REFC ->(end) 233# 1 <0> enter ->2 234# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3 235# 5 <2> sassign vKS/2 ->6 236# 3 <0> undef s ->4 237# - <1> ex-rv2sv sKRM*/17 ->5 238# 4 <$> gvsv(*a) s/OURINTR ->5 239EONT_EONT 240 241checkOptree ( name => 'local $a=undef', 242 prog => 'local $a=undef', 243 errs => ['Name "main::a" used only once: possible typo at -e line 1.'], 244 note => 'locals are rare, probably not worth doing', 245 bcopts => '-basic', 246 strip_open_hints => 1, 247 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 2486 <@> leave[1 ref] vKP/REFC ->(end) 2491 <0> enter ->2 2502 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3 2515 <2> sassign vKS/2 ->6 2523 <0> undef s ->4 253- <1> ex-rv2sv sKRM*/129 ->5 2544 <#> gvsv[*a] s/LVINTRO ->5 255EOT_EOT 256# 6 <@> leave[1 ref] vKP/REFC ->(end) 257# 1 <0> enter ->2 258# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3 259# 5 <2> sassign vKS/2 ->6 260# 3 <0> undef s ->4 261# - <1> ex-rv2sv sKRM*/129 ->5 262# 4 <$> gvsv(*a) s/LVINTRO ->5 263EONT_EONT 264 265checkOptree ( name => 'sub {my $a=()}', 266 code => sub {my $a=()}, 267 bcopts => '-exec', 268 strip_open_hints => 1, 269 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 2701 <;> nextstate(main -439 optree.t:105) v:>,<,% 2712 <0> stub sP 2723 <0> padsv[$a:-439,-438] sRM*/LVINTRO 2734 <2> sassign sKS/2 2745 <1> leavesub[1 ref] K/REFC,1 275EOT_EOT 276# 1 <;> nextstate(main 438 optree_varinit.t:247) v:>,<,% 277# 2 <0> stub sP 278# 3 <0> padsv[$a:438,439] sRM*/LVINTRO 279# 4 <2> sassign sKS/2 280# 5 <1> leavesub[1 ref] K/REFC,1 281EONT_EONT 282 283checkOptree ( name => 'sub {our $a=()}', 284 code => sub {our $a=()}, 285 #todo => 'probly not worth doing', 286 bcopts => '-exec', 287 strip_open_hints => 1, 288 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 2891 <;> nextstate(main 31 optree.t:177) v:>,<,%,{ 2902 <0> stub sP 2913 <#> gvsv[*a] s/OURINTR 2924 <2> sassign sKS/2 2935 <1> leavesub[1 ref] K/REFC,1 294EOT_EOT 295# 1 <;> nextstate(main 440 optree_varinit.t:262) v:>,<,%,{ 296# 2 <0> stub sP 297# 3 <$> gvsv(*a) s/OURINTR 298# 4 <2> sassign sKS/2 299# 5 <1> leavesub[1 ref] K/REFC,1 300EONT_EONT 301 302checkOptree ( name => 'sub {local $a=()}', 303 code => sub {local $a=()}, 304 #todo => 'probly not worth doing', 305 bcopts => '-exec', 306 strip_open_hints => 1, 307 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 3081 <;> nextstate(main 33 optree.t:190) v:>,<,%,{ 3092 <0> stub sP 3103 <#> gvsv[*a] s/LVINTRO 3114 <2> sassign sKS/2 3125 <1> leavesub[1 ref] K/REFC,1 313EOT_EOT 314# 1 <;> nextstate(main 63 optree.t:225) v:>,<,%,{ 315# 2 <0> stub sP 316# 3 <$> gvsv(*a) s/LVINTRO 317# 4 <2> sassign sKS/2 318# 5 <1> leavesub[1 ref] K/REFC,1 319EONT_EONT 320 321checkOptree ( name => 'my $a=()', 322 prog => 'my $a=()', 323 bcopts => '-exec', 324 strip_open_hints => 1, 325 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 3261 <0> enter 3272 <;> nextstate(main 1 -e:1) v:>,<,%,{ 3283 <0> stub sP 3294 <0> padsv[$a:1,2] sRM*/LVINTRO 3305 <2> sassign vKS/2 3316 <@> leave[1 ref] vKP/REFC 332EOT_EOT 333# 1 <0> enter 334# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ 335# 3 <0> stub sP 336# 4 <0> padsv[$a:1,2] sRM*/LVINTRO 337# 5 <2> sassign vKS/2 338# 6 <@> leave[1 ref] vKP/REFC 339EONT_EONT 340 341checkOptree ( name => 'our $a=()', 342 prog => 'our $a=()', 343 #todo => 'probly not worth doing', 344 bcopts => '-exec', 345 strip_open_hints => 1, 346 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 3471 <0> enter 3482 <;> nextstate(main 1 -e:1) v:>,<,%,{ 3493 <0> stub sP 3504 <#> gvsv[*a] s/OURINTR 3515 <2> sassign vKS/2 3526 <@> leave[1 ref] vKP/REFC 353EOT_EOT 354# 1 <0> enter 355# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ 356# 3 <0> stub sP 357# 4 <$> gvsv(*a) s/OURINTR 358# 5 <2> sassign vKS/2 359# 6 <@> leave[1 ref] vKP/REFC 360EONT_EONT 361 362checkOptree ( name => 'local $a=()', 363 prog => 'local $a=()', 364 errs => ['Name "main::a" used only once: possible typo at -e line 1.'], 365 #todo => 'probly not worth doing', 366 bcopts => '-exec', 367 strip_open_hints => 1, 368 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 3691 <0> enter 3702 <;> nextstate(main 1 -e:1) v:>,<,%,{ 3713 <0> stub sP 3724 <#> gvsv[*a] s/LVINTRO 3735 <2> sassign vKS/2 3746 <@> leave[1 ref] vKP/REFC 375EOT_EOT 376# 1 <0> enter 377# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ 378# 3 <0> stub sP 379# 4 <$> gvsv(*a) s/LVINTRO 380# 5 <2> sassign vKS/2 381# 6 <@> leave[1 ref] vKP/REFC 382EONT_EONT 383 384checkOptree ( name => 'my ($a,$b)=()', 385 prog => 'my ($a,$b)=()', 386 #todo => 'probly not worth doing', 387 bcopts => '-exec', 388 strip_open_hints => 1, 389 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 390# 1 <0> enter 391# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ 392# 3 <0> pushmark s 393# 4 <0> pushmark sRM*/128 394# 5 <0> padsv[$a:1,2] lRM*/LVINTRO 395# 6 <0> padsv[$b:1,2] lRM*/LVINTRO 396# 7 <2> aassign[t3] vKS 397# 8 <@> leave[1 ref] vKP/REFC 398EOT_EOT 399# 1 <0> enter 400# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ 401# 3 <0> pushmark s 402# 4 <0> pushmark sRM*/128 403# 5 <0> padsv[$a:1,2] lRM*/LVINTRO 404# 6 <0> padsv[$b:1,2] lRM*/LVINTRO 405# 7 <2> aassign[t3] vKS 406# 8 <@> leave[1 ref] vKP/REFC 407EONT_EONT 408