| 1 | #!perl |
| 2 | |
| 3 | BEGIN { |
| 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 | } |
| 11 | use OptreeCheck; |
| 12 | use Config; |
| 13 | plan tests => 3; |
| 14 | |
| 15 | SKIP: { |
| 16 | skip "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 | |
| 24 | checkOptree ( 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 ->- |
| 44 | EOT_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 ->- |
| 61 | EONT_EONT |
| 62 | |
| 63 | |
| 64 | } #skip |
| 65 | |
| 66 | my $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 |
| 77 | EOT_EOT |
| 78 | my $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 |
| 89 | EONT_EONT |
| 90 | |
| 91 | if ($] < 5.009) { |
| 92 | $t =~ s/GV /BM /; |
| 93 | $nt =~ s/GV /BM /; |
| 94 | } |
| 95 | |
| 96 | checkOptree ( name => 'index and PVBM', |
| 97 | prog => '$_ = index q(foo), q(foo)', |
| 98 | strip_open_hints => 1, |
| 99 | expect => $t, expect_nt => $nt); |
| 100 | |
| 101 | checkOptree ( name => 'PMOP children', |
| 102 | code => sub { $foo =~ s/(a)/$1/ }, |
| 103 | strip_open_hints => 1, |
| 104 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); |
| 105 | # 6 <1> leavesub[1 ref] K/REFC,1 ->(end) |
| 106 | # - <@> lineseq KP ->6 |
| 107 | # 1 <;> nextstate(main 1 -e:1) v:{ ->2 |
| 108 | # 3 </> subst(/"(a)"/ replstart->4) KS ->6 |
| 109 | # - <1> ex-rv2sv sKRM/1 ->3 |
| 110 | # 2 <#> gvsv[*foo] s ->3 |
| 111 | # 5 <|> substcont(other->3) sK/1 ->(end) |
| 112 | # - <1> ex-rv2sv sK/1 ->5 |
| 113 | # 4 <#> gvsv[*1] s ->5 |
| 114 | EOT_EOT |
| 115 | # 6 <1> leavesub[1 ref] K/REFC,1 ->(end) |
| 116 | # - <@> lineseq KP ->6 |
| 117 | # 1 <;> nextstate(main 1 -e:1) v:{ ->2 |
| 118 | # 3 </> subst(/"(a)"/ replstart->4) KS ->6 |
| 119 | # - <1> ex-rv2sv sKRM/1 ->3 |
| 120 | # 2 <$> gvsv(*foo) s ->3 |
| 121 | # 5 <|> substcont(other->3) sK/1 ->(end) |
| 122 | # - <1> ex-rv2sv sK/1 ->5 |
| 123 | # 4 <$> gvsv(*1) s ->5 |
| 124 | EONT_EONT |
| 125 | |
| 126 | __END__ |