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} 11use OptreeCheck; 12use Config; 13plan tests => 2; 14 15SKIP: { 16skip "no perlio in this build", 1 unless $Config::Config{useperlio}; 17 18# The regression this is testing is that the first aelemfast, derived 19# from a lexical array, is supposed to be a BASEOP "<0>", while the 20# second, from a global, is an SVOP "<$>" or a PADOP "<#>" depending 21# on threading. In buggy versions, both showed up as SVOPs/PADOPs. See 22# B.xs:cc_opclass() for the relevant code. 23 24checkOptree ( name => 'OP_AELEMFAST opclass', 25 code => sub { my @x; our @y; $x[0] + $y[0]}, 26 strip_open_hints => 1, 27 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 28# a <1> leavesub[1 ref] K/REFC,1 ->(end) 29# - <@> lineseq KP ->a 30# 1 <;> nextstate(main 634 optree_misc.t:25) v:>,<,% ->2 31# 2 <0> padav[@x:634,636] vM/LVINTRO ->3 32# 3 <;> nextstate(main 635 optree_misc.t:25) v:>,<,% ->4 33# 5 <1> rv2av[t4] vK/OURINTR,1 ->6 34# 4 <#> gv[*y] s ->5 35# 6 <;> nextstate(main 636 optree_misc.t:25) v:>,<,%,{ ->7 36# 9 <2> add[t6] sK/2 ->a 37# - <1> ex-aelem sK/2 ->8 38# 7 <0> aelemfast[@x:634,636] sR* ->8 39# - <0> ex-const s ->- 40# - <1> ex-aelem sK/2 ->9 41# - <1> ex-rv2av sKR/1 ->- 42# 8 <#> aelemfast[*y] s ->9 43# - <0> ex-const s ->- 44EOT_EOT 45# a <1> leavesub[1 ref] K/REFC,1 ->(end) 46# - <@> lineseq KP ->a 47# 1 <;> nextstate(main 634 optree_misc.t:27) v:>,<,% ->2 48# 2 <0> padav[@x:634,636] vM/LVINTRO ->3 49# 3 <;> nextstate(main 635 optree_misc.t:27) v:>,<,% ->4 50# 5 <1> rv2av[t3] vK/OURINTR,1 ->6 51# 4 <$> gv(*y) s ->5 52# 6 <;> nextstate(main 636 optree_misc.t:27) v:>,<,%,{ ->7 53# 9 <2> add[t4] sK/2 ->a 54# - <1> ex-aelem sK/2 ->8 55# 7 <0> aelemfast[@x:634,636] sR* ->8 56# - <0> ex-const s ->- 57# - <1> ex-aelem sK/2 ->9 58# - <1> ex-rv2av sKR/1 ->- 59# 8 <$> aelemfast(*y) s ->9 60# - <0> ex-const s ->- 61EONT_EONT 62 63 64} #skip 65 66my $t = <<'EOT_EOT'; 67# 8 <@> leave[1 ref] vKP/REFC ->(end) 68# 1 <0> enter ->2 69# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3 70# 7 <2> sassign vKS/2 ->8 71# 5 <@> index[t2] sK/2 ->6 72# - <0> ex-pushmark s ->3 73# 3 <$> const[PV "foo"] s ->4 74# 4 <$> const[GV "foo"] s ->5 75# - <1> ex-rv2sv sKRM*/1 ->7 76# 6 <#> gvsv[*_] s ->7 77EOT_EOT 78my $nt = <<'EONT_EONT'; 79# 8 <@> leave[1 ref] vKP/REFC ->(end) 80# 1 <0> enter ->2 81# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3 82# 7 <2> sassign vKS/2 ->8 83# 5 <@> index[t1] sK/2 ->6 84# - <0> ex-pushmark s ->3 85# 3 <$> const(PV "foo") s ->4 86# 4 <$> const(GV "foo") s ->5 87# - <1> ex-rv2sv sKRM*/1 ->7 88# 6 <$> gvsv(*_) s ->7 89EONT_EONT 90 91if ($] < 5.009) { 92 $t =~ s/GV /BM /; 93 $nt =~ s/GV /BM /; 94} 95 96checkOptree ( name => 'index and PVBM', 97 prog => '$_ = index q(foo), q(foo)', 98 strip_open_hints => 1, 99 expect => $t, expect_nt => $nt); 100 101__END__ 102 103