t/43-peep.t

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7
   8 use lib 't/lib';
   9 use VPIT::TestHelpers;
  10
  11 plan tests => 11 + 1 * 2 + 5 * 3;
  12
  13 {
  14  my $desc = 'peephole optimization of conditionals';
  15  my $x;
  16
  17  local $@;
  18  my $code = eval <<' TESTCASE';
  19   no autovivification;
  20   sub {
  21    if ($_[0]) {
  22     my $z = $x->{a};
  23     return 1;
  24    } elsif ($_[1] || $_[2]) {
  25     my $z = $x->{b};
  26     return 2;
  27    } elsif ($_[3] && $_[4]) {
  28     my $z = $x->{c};
  29     return 3;
  30    } elsif ($_[5] ? $_[6] : 0) {
  31     my $z = $x->{d};
  32     return 4;
  33    } else {
  34     my $z = $x->{e};
  35     return 5;
  36    }
  37    return 0;
  38   }
  39  TESTCASE
  40  is $@, '', "$desc compiled fine";
  41
  42  my $ret = $code->(1);
  43  is_deeply $x, undef, "$desc : first branch did not autovivify";
  44  is      $ret, 1,     "$desc : first branch returned 1";
  45
  46  $ret = $code->(0, 1);
  47  is_deeply $x, undef, "$desc : second branch did not autovivify";
  48  is      $ret, 2,     "$desc : second branch returned 2";
  49
  50  $ret = $code->(0, 0, 0, 1, 1);
  51  is_deeply $x, undef, "$desc : third branch did not autovivify";
  52  is      $ret, 3,     "$desc : third branch returned 3";
  53
  54  $ret = $code->(0, 0, 0, 0, 0, 1, 1);
  55  is_deeply $x, undef, "$desc : fourth branch did not autovivify";
  56  is      $ret, 4,     "$desc : fourth branch returned 4";
  57
  58  $ret = $code->();
  59  is_deeply $x, undef, "$desc : fifth branch did not autovivify";
  60  is      $ret, 5,     "$desc : fifth branch returned 5";
  61 }
  62
  63 {
  64  my $desc = 'peephole optimization of C-style loops';
  65  my $x;
  66
  67  local $@;
  68  my $code = eval <<' TESTCASE';
  69   no autovivification;
  70   sub {
  71    my $ret = 0;
  72    for (
  73      my ($z, $i) = ($x->[100], 0)
  74     ;
  75      do { my $z = $x->[200]; $i < 4 }
  76     ;
  77      do { my $z = $x->[300]; ++$i }
  78    ) {
  79     my $z = $x->[$i];
  80     $ret += $i;
  81    }
  82    return $ret;
  83   }
  84  TESTCASE
  85  is $@, '', "$desc compiled fine";
  86
  87  my $ret = $code->();
  88  is_deeply $x, undef, "$desc did not autovivify";
  89  is      $ret, 6,     "$desc returned 0+1+2+3";
  90 }
  91
  92 {
  93  my $desc = 'peephole optimization of range loops';
  94  my $x;
  95
  96  local $@;
  97  my $code = eval <<' TESTCASE';
  98   no autovivification;
  99   sub {
 100    my $ret = 0;
 101    for ((do { my $z = $x->[100]; 0 }) .. (do { my $z = $x->[200]; 3 })) {
 102     my $z = $x->[$_];
 103     $ret += $_;
 104    }
 105    return $ret;
 106   }
 107  TESTCASE
 108  is $@, '', "$desc compiled fine";
 109
 110  my $ret = $code->();
 111  is_deeply $x, undef, "$desc did not autovivify";
 112  is      $ret, 6,     "$desc returned 0+1+2+3";
 113 }
 114
 115 {
 116  my %infinite_tests = (
 117   'peephole optimization of infinite for loops (RT #64435)' => <<'  TESTCASE',
 118    no autovivification;
 119    my $ret = 0;
 120    for (;;) {
 121     ++$ret;
 122     exit $ret;
 123    }
 124    exit $ret;
 125   TESTCASE
 126  );
 127
 128  for my $desc (keys %infinite_tests) {
 129   my $code = $infinite_tests{$desc};
 130   my $ret  = run_perl $code;
 131   my $stat = $ret & 255;
 132   $ret   >>= 8;
 133   is $stat, 0, "$desc testcase did not crash";
 134   is $ret,  1, "$desc compiled fine";
 135  }
 136 }
 137
 138 {
 139  my $desc = 'peephole optimization of map';
 140  my $x;
 141
 142  local $@;
 143  my $code = eval <<' TESTCASE';
 144   no autovivification;
 145   sub {
 146    join ':', map {
 147     my $z = $x->[$_];
 148     "x${_}y"
 149    } @_
 150   }
 151  TESTCASE
 152  is $@, '', "$desc compiled fine";
 153
 154  my $ret = $code->(1, 2);
 155  is_deeply $x, undef,     "$desc did not autovivify";
 156  is      $ret, 'x1y:x2y', "$desc returned the right value";
 157 }
 158
 159 {
 160  my $desc = 'peephole optimization of grep';
 161  my $x;
 162
 163  local $@;
 164  my $code = eval <<' TESTCASE';
 165   no autovivification;
 166   sub {
 167    join ':', grep {
 168     my $z = $x->[$_];
 169     $_ <= 3
 170    } @_
 171   }
 172  TESTCASE
 173  is $@, '', "$desc compiled fine";
 174
 175  my $ret = $code->(1 .. 5);
 176  is_deeply $x, undef,   "$desc did not autovivify";
 177  is      $ret, '1:2:3', "$desc returned the right value";
 178 }
 179
 180 {
 181  my $desc = 'peephole optimization of substitutions';
 182  my $x;
 183
 184  local $@;
 185  my $code = eval <<' TESTCASE';
 186   no autovivification;
 187   sub {
 188    my $str = $_[0];
 189    $str =~ s{
 190     ([0-9])
 191    }{
 192     my $z = $x->[$1];
 193     9 - $1;
 194    }xge;
 195    $str;
 196   }
 197  TESTCASE
 198  is $@, '', "$desc compiled fine";
 199
 200  my $ret = $code->('0123456789');
 201  is_deeply $x, undef,        "$desc did not autovivify";
 202  is      $ret, '9876543210', "$desc returned the right value";
 203 }