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 => 2;
  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 __END__
 102