ext/B/t/optree_misc.t

   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 => 12;
  14
  15 SKIP: {
  16 skip "no perlio in this build", 4 unless $Config::Config{useperlio};
  17
  18 # The regression this was 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 # All this is much simpler, now that aelemfast_lex has been broken out from
  25 # aelemfast
  26 checkOptree ( name      => 'OP_AELEMFAST opclass',
  27               code      => sub { my @x; our @y; $x[0] + $y[0]},
  28               strip_open_hints => 1,
  29               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
  30 # a  <1> leavesub[1 ref] K/REFC,1 ->(end)
  31 # -     <@> lineseq KP ->a
  32 # 1        <;> nextstate(main 634 optree_misc.t:25) v:>,<,% ->2
  33 # 2        <0> padav[@x:634,636] vM/LVINTRO ->3
  34 # 3        <;> nextstate(main 635 optree_misc.t:25) v:>,<,% ->4
  35 # 5        <1> rv2av[t4] vK/OURINTR,1 ->6
  36 # 4           <#> gv[*y] s ->5
  37 # 6        <;> nextstate(main 636 optree_misc.t:25) v:>,<,%,{ ->7
  38 # 9        <2> add[t6] sK/2 ->a
  39 # -           <1> ex-aelem sK/2 ->8
  40 # 7              <0> aelemfast_lex[@x:634,636] sR ->8
  41 # -              <0> ex-const s ->-
  42 # -           <1> ex-aelem sK/2 ->9
  43 # -              <1> ex-rv2av sKR/1 ->-
  44 # 8                 <#> aelemfast[*y] s ->9
  45 # -              <0> ex-const s ->-
  46 EOT_EOT
  47 # a  <1> leavesub[1 ref] K/REFC,1 ->(end)
  48 # -     <@> lineseq KP ->a
  49 # 1        <;> nextstate(main 634 optree_misc.t:27) v:>,<,% ->2
  50 # 2        <0> padav[@x:634,636] vM/LVINTRO ->3
  51 # 3        <;> nextstate(main 635 optree_misc.t:27) v:>,<,% ->4
  52 # 5        <1> rv2av[t3] vK/OURINTR,1 ->6
  53 # 4           <$> gv(*y) s ->5
  54 # 6        <;> nextstate(main 636 optree_misc.t:27) v:>,<,%,{ ->7
  55 # 9        <2> add[t4] sK/2 ->a
  56 # -           <1> ex-aelem sK/2 ->8
  57 # 7              <0> aelemfast_lex[@x:634,636] sR ->8
  58 # -              <0> ex-const s ->-
  59 # -           <1> ex-aelem sK/2 ->9
  60 # -              <1> ex-rv2av sKR/1 ->-
  61 # 8                 <$> aelemfast(*y) s ->9
  62 # -              <0> ex-const s ->-
  63 EONT_EONT
  64
  65 checkOptree ( name      => 'PMOP children',
  66               code      => sub { $foo =~ s/(a)/$1/ },
  67               strip_open_hints => 1,
  68               ( $] < 5.017002
  69                 ?  (expect => <<'EOT_EOT16', expect_nt => <<'EONT_EONT16')
  70 # 6  <1> leavesub[1 ref] K/REFC,1 ->(end)
  71 # -     <@> lineseq KP ->6
  72 # 1        <;> nextstate(main 1 -e:1) v:>,<,%,{ ->2
  73 # 3        </> subst(/"(a)"/ replstart->4) KS ->6
  74 # -           <1> ex-rv2sv sKRM/1 ->3
  75 # 2              <#> gvsv[*foo] s ->3
  76 # 5           <|> substcont(other->3) sK/1 ->(end)
  77 # -              <1> ex-rv2sv sK/1 ->5
  78 # 4                 <#> gvsv[*1] s ->5
  79 EOT_EOT16
  80 # 6  <1> leavesub[1 ref] K/REFC,1 ->(end)
  81 # -     <@> lineseq KP ->6
  82 # 1        <;> nextstate(main 1 -e:1) v:>,<,%,{ ->2
  83 # 3        </> subst(/"(a)"/ replstart->4) KS ->6
  84 # -           <1> ex-rv2sv sKRM/1 ->3
  85 # 2              <$> gvsv(*foo) s ->3
  86 # 5           <|> substcont(other->3) sK/1 ->(end)
  87 # -              <1> ex-rv2sv sK/1 ->5
  88 # 4                 <$> gvsv(*1) s ->5
  89 EONT_EONT16
  90
  91                 :  (expect => <<'EOT_EOT',   expect_nt => <<'EONT_EONT')));
  92 # 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
  93 # -     <@> lineseq KP ->5
  94 # 1        <;> nextstate(main 1 -e:1) v:>,<,%,{ ->2
  95 # 4        </> subst(/"(a)"/) KS ->5
  96 # -           <1> ex-rv2sv sKRM/1 ->3
  97 # 2              <#> gvsv[*foo] s ->3
  98 # -           <1> ex-rv2sv sK/1 ->4
  99 # 3              <#> gvsv[*1] s ->4
 100 EOT_EOT
 101 # 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
 102 # -     <@> lineseq KP ->5
 103 # 1        <;> nextstate(main 1 -e:1) v:>,<,%,{ ->2
 104 # 4        </> subst(/"(a)"/) KS ->5
 105 # -           <1> ex-rv2sv sKRM/1 ->3
 106 # 2              <$> gvsv(*foo) s ->3
 107 # -           <1> ex-rv2sv sK/1 ->4
 108 # 3              <$> gvsv(*1) s ->4
 109 EONT_EONT
 110
 111 } #skip
 112
 113 my $t = <<'EOT_EOT';
 114 # 8  <@> leave[1 ref] vKP/REFC ->(end)
 115 # 1     <0> enter ->2
 116 # 2     <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3
 117 # 7     <2> sassign vKS/2 ->8
 118 # 5        <@> index[t2] sK/2 ->6
 119 # -           <0> ex-pushmark s ->3
 120 # 3           <$> const[PV "foo"] s ->4
 121 # 4           <$> const[PVMG "foo"] s ->5
 122 # -        <1> ex-rv2sv sKRM*/1 ->7
 123 # 6           <#> gvsv[*_] s ->7
 124 EOT_EOT
 125 my $nt = <<'EONT_EONT';
 126 # 8  <@> leave[1 ref] vKP/REFC ->(end)
 127 # 1     <0> enter ->2
 128 # 2     <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3
 129 # 7     <2> sassign vKS/2 ->8
 130 # 5        <@> index[t1] sK/2 ->6
 131 # -           <0> ex-pushmark s ->3
 132 # 3           <$> const(PV "foo") s ->4
 133 # 4           <$> const(PVMG "foo") s ->5
 134 # -        <1> ex-rv2sv sKRM*/1 ->7
 135 # 6           <$> gvsv(*_) s ->7
 136 EONT_EONT
 137
 138 checkOptree ( name      => 'index and PVBM',
 139               prog      => '$_ = index q(foo), q(foo)',
 140               strip_open_hints => 1,
 141               expect    => $t,  expect_nt => $nt);
 142
 143 my $tmpfile = tempfile();
 144 open my $fh, '>', $tmpfile or die "Cannot open $tmpfile: $!";
 145 print $fh "no warnings;format =\n@<<<\n\$a\n@>>>\n\@b\n.";
 146 close $fh;
 147
 148 checkOptree ( name      => 'formats',
 149               bcopts    => 'STDOUT',
 150               progfile  => $tmpfile,
 151               strip_open_hints => 1,
 152               skip      => ($] < 5.017003),
 153               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 154 # main::STDOUT (FORMAT):
 155 # c  <1> leavewrite[1 ref] K/REFC,1 ->(end)
 156 # -     <@> lineseq KP ->c
 157 # 1        <;> nextstate(main 1 -:4) v:>,<,% ->2
 158 # 5        <@> formline vK/2 ->6
 159 # 2           <0> pushmark s ->3
 160 # 3           <$> const[PV "@<<<\n"] s ->4
 161 # -           <@> lineseq lK ->5
 162 # -              <0> ex-nextstate v ->4
 163 # -              <1> ex-rv2sv sK/1 ->-
 164 # 4                 <#> gvsv[*a] s ->5
 165 # 6        <;> nextstate(main 1 -:6) v:>,<,% ->7
 166 # b        <@> formline sK/2 ->c
 167 # 7           <0> pushmark s ->8
 168 # 8           <$> const[PV "@>>>\n"] s ->9
 169 # -           <@> lineseq lK ->b
 170 # -              <0> ex-nextstate v ->9
 171 # a              <1> rv2av[t3] lK/1 ->b
 172 # 9                 <#> gv[*b] s ->a
 173 EOT_EOT
 174 # main::STDOUT (FORMAT):
 175 # c  <1> leavewrite[1 ref] K/REFC,1 ->(end)
 176 # -     <@> lineseq KP ->c
 177 # 1        <;> nextstate(main 1 -:4) v:>,<,% ->2
 178 # 5        <@> formline vK/2 ->6
 179 # 2           <0> pushmark s ->3
 180 # 3           <$> const(PV "@<<<\n") s ->4
 181 # -           <@> lineseq lK ->5
 182 # -              <0> ex-nextstate v ->4
 183 # -              <1> ex-rv2sv sK/1 ->-
 184 # 4                 <$> gvsv(*a) s ->5
 185 # 6        <;> nextstate(main 1 -:6) v:>,<,% ->7
 186 # b        <@> formline sK/2 ->c
 187 # 7           <0> pushmark s ->8
 188 # 8           <$> const(PV "@>>>\n") s ->9
 189 # -           <@> lineseq lK ->b
 190 # -              <0> ex-nextstate v ->9
 191 # a              <1> rv2av[t3] lK/1 ->b
 192 # 9                 <$> gv(*b) s ->a
 193 EONT_EONT
 194
 195 checkOptree ( name      => 'padrange',
 196               code      => sub { my ($x,$y); @a = ($x,$y); ($x,$y) = @a },
 197               strip_open_hints => 1,
 198               skip      => ($] < 5.017006),
 199               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 200 # f  <1> leavesub[1 ref] K/REFC,1 ->(end)
 201 # -     <@> lineseq KP ->f
 202 # 1        <;> nextstate(main 1 -e:1) v ->2
 203 # -        <@> list vKP ->3
 204 # 2           <0> padrange[$x:1,2; $y:1,2] vM/LVINTRO,2 ->3
 205 # -           <0> padsv[$x:1,2] vM/LVINTRO ->-
 206 # -           <0> padsv[$y:1,2] vM/LVINTRO ->-
 207 # 3        <;> nextstate(main 2 -e:1) v ->4
 208 # 8        <2> aassign[t4] vKS ->9
 209 # -           <1> ex-list lKP ->5
 210 # 4              <0> padrange[$x:1,2; $y:1,2] l/2 ->5
 211 # -              <0> padsv[$x:1,2] l ->-
 212 # -              <0> padsv[$y:1,2] l ->-
 213 # -           <1> ex-list lK ->8
 214 # 5              <0> pushmark s ->6
 215 # 7              <1> rv2av[t3] lKRM*/1 ->8
 216 # 6                 <#> gv[*a] s ->7
 217 # 9        <;> nextstate(main 2 -e:1) v:{ ->a
 218 # e        <2> aassign[t6] KS ->f
 219 # -           <1> ex-list lK ->d
 220 # a              <0> pushmark s ->b
 221 # c              <1> rv2av[t5] lK/1 ->d
 222 # b                 <#> gv[*a] s ->c
 223 # -           <1> ex-list lKPRM* ->e
 224 # d              <0> padrange[$x:1,2; $y:1,2] lRM/2 ->e
 225 # -              <0> padsv[$x:1,2] lRM* ->-
 226 # -              <0> padsv[$y:1,2] lRM* ->-
 227 EOT_EOT
 228 # f  <1> leavesub[1 ref] K/REFC,1 ->(end)
 229 # -     <@> lineseq KP ->f
 230 # 1        <;> nextstate(main 1 -e:1) v ->2
 231 # -        <@> list vKP ->3
 232 # 2           <0> padrange[$x:1,2; $y:1,2] vM/LVINTRO,2 ->3
 233 # -           <0> padsv[$x:1,2] vM/LVINTRO ->-
 234 # -           <0> padsv[$y:1,2] vM/LVINTRO ->-
 235 # 3        <;> nextstate(main 2 -e:1) v ->4
 236 # 8        <2> aassign[t4] vKS ->9
 237 # -           <1> ex-list lKP ->5
 238 # 4              <0> padrange[$x:1,2; $y:1,2] l/2 ->5
 239 # -              <0> padsv[$x:1,2] l ->-
 240 # -              <0> padsv[$y:1,2] l ->-
 241 # -           <1> ex-list lK ->8
 242 # 5              <0> pushmark s ->6
 243 # 7              <1> rv2av[t3] lKRM*/1 ->8
 244 # 6                 <$> gv(*a) s ->7
 245 # 9        <;> nextstate(main 2 -e:1) v:{ ->a
 246 # e        <2> aassign[t6] KS ->f
 247 # -           <1> ex-list lK ->d
 248 # a              <0> pushmark s ->b
 249 # c              <1> rv2av[t5] lK/1 ->d
 250 # b                 <$> gv(*a) s ->c
 251 # -           <1> ex-list lKPRM* ->e
 252 # d              <0> padrange[$x:1,2; $y:1,2] lRM/2 ->e
 253 # -              <0> padsv[$x:1,2] lRM* ->-
 254 # -              <0> padsv[$y:1,2] lRM* ->-
 255 EONT_EONT
 256
 257 checkOptree ( name      => 'padrange and @_',
 258               code      => sub { my ($a,$b) = @_;
 259                                  my ($c,$d) = @X::_;
 260                                  package Y;
 261                                  my ($e,$f) = @_;
 262                              },
 263               strip_open_hints => 1,
 264               skip      => ($] < 5.017006),
 265               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 266 # d  <1> leavesub[1 ref] K/REFC,1 ->(end)
 267 # -     <@> lineseq KP ->d
 268 # 1        <;> nextstate(main 1 p3:1) v ->2
 269 # 3        <2> aassign[t5] vKS ->4
 270 # -           <1> ex-list lK ->-
 271 # 2              <0> padrange[$a:1,4; $b:1,4] l*/LVINTRO,2 ->3
 272 # -              <1> rv2av[t4] lK/1 ->-
 273 # -                 <#> gv[*_] s ->-
 274 # -           <1> ex-list lKPRM* ->3
 275 # -              <0> pushmark sRM*/LVINTRO ->-
 276 # -              <0> padsv[$a:1,4] lRM*/LVINTRO ->-
 277 # -              <0> padsv[$b:1,4] lRM*/LVINTRO ->-
 278 # 4        <;> nextstate(main 2 p3:2) v ->5
 279 # 9        <2> aassign[t10] vKS ->a
 280 # -           <1> ex-list lK ->8
 281 # 5              <0> pushmark s ->6
 282 # 7              <1> rv2av[t9] lK/1 ->8
 283 # 6                 <#> gv[*X::_] s ->7
 284 # -           <1> ex-list lKPRM* ->9
 285 # 8              <0> padrange[$c:2,4; $d:2,4] lRM/LVINTRO,2 ->9
 286 # -              <0> padsv[$c:2,4] lRM*/LVINTRO ->-
 287 # -              <0> padsv[$d:2,4] lRM*/LVINTRO ->-
 288 # a        <;> nextstate(Y 3 p3:4) v:{ ->b
 289 # c        <2> aassign[t15] KS ->d
 290 # -           <1> ex-list lK ->-
 291 # b              <0> padrange[$e:3,4; $f:3,4] l*/LVINTRO,2 ->c
 292 # -              <1> rv2av[t14] lK/1 ->-
 293 # -                 <#> gv[*_] s ->-
 294 # -           <1> ex-list lKPRM* ->c
 295 # -              <0> pushmark sRM*/LVINTRO ->-
 296 # -              <0> padsv[$e:3,4] lRM*/LVINTRO ->-
 297 # -              <0> padsv[$f:3,4] lRM*/LVINTRO ->-
 298 EOT_EOT
 299 # d  <1> leavesub[1 ref] K/REFC,1 ->(end)
 300 # -     <@> lineseq KP ->d
 301 # 1        <;> nextstate(main 1 p3:1) v ->2
 302 # 3        <2> aassign[t5] vKS ->4
 303 # -           <1> ex-list lK ->-
 304 # 2              <0> padrange[$a:1,4; $b:1,4] l*/LVINTRO,2 ->3
 305 # -              <1> rv2av[t4] lK/1 ->-
 306 # -                 <$> gv(*_) s ->-
 307 # -           <1> ex-list lKPRM* ->3
 308 # -              <0> pushmark sRM*/LVINTRO ->-
 309 # -              <0> padsv[$a:1,4] lRM*/LVINTRO ->-
 310 # -              <0> padsv[$b:1,4] lRM*/LVINTRO ->-
 311 # 4        <;> nextstate(main 2 p3:2) v ->5
 312 # 9        <2> aassign[t10] vKS ->a
 313 # -           <1> ex-list lK ->8
 314 # 5              <0> pushmark s ->6
 315 # 7              <1> rv2av[t9] lK/1 ->8
 316 # 6                 <$> gv(*X::_) s ->7
 317 # -           <1> ex-list lKPRM* ->9
 318 # 8              <0> padrange[$c:2,4; $d:2,4] lRM/LVINTRO,2 ->9
 319 # -              <0> padsv[$c:2,4] lRM*/LVINTRO ->-
 320 # -              <0> padsv[$d:2,4] lRM*/LVINTRO ->-
 321 # a        <;> nextstate(Y 3 p3:4) v:{ ->b
 322 # c        <2> aassign[t15] KS ->d
 323 # -           <1> ex-list lK ->-
 324 # b              <0> padrange[$e:3,4; $f:3,4] l*/LVINTRO,2 ->c
 325 # -              <1> rv2av[t14] lK/1 ->-
 326 # -                 <$> gv(*_) s ->-
 327 # -           <1> ex-list lKPRM* ->c
 328 # -              <0> pushmark sRM*/LVINTRO ->-
 329 # -              <0> padsv[$e:3,4] lRM*/LVINTRO ->-
 330 # -              <0> padsv[$f:3,4] lRM*/LVINTRO ->-
 331 EONT_EONT
 332
 333 unlink $tmpfile;