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 + 5 * 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 $base_desc = 'peephole optimization of infinite';
 117  my %infinite_tests = (
 118   "$base_desc for loops (RT #64435)" => <<'  TESTCASE',
 119    no autovivification;
 120    my $ret = 0;
 121    for (;;) {
 122     ++$ret;
 123     exit $ret;
 124    }
 125    exit $ret;
 126   TESTCASE
 127   "$base_desc while loops" => <<'  TESTCASE',
 128    no autovivification;
 129    my $ret = 0;
 130    while (1) {
 131     ++$ret;
 132     exit $ret;
 133    }
 134    exit $ret;
 135   TESTCASE
 136   "$base_desc postfix while (RT #99458)" => <<'  TESTCASE',
 137    no autovivification;
 138    my $ret = 0;
 139    ++$ret && exit $ret while 1;
 140    exit $ret;
 141   TESTCASE
 142   "$base_desc until loops" => <<'  TESTCASE',
 143    no autovivification;
 144    my $ret = 0;
 145    until (0) {
 146     ++$ret;
 147     exit $ret;
 148    }
 149    exit $ret;
 150   TESTCASE
 151   "$base_desc postfix until" => <<'  TESTCASE',
 152    no autovivification;
 153    my $ret = 0;
 154    ++$ret && exit $ret until 0;
 155    exit $ret;
 156   TESTCASE
 157  );
 158
 159  for my $desc (keys %infinite_tests) {
 160   my $code = $infinite_tests{$desc};
 161   my $ret  = run_perl $code;
 162   my $stat = $ret & 255;
 163   $ret   >>= 8;
 164   is $stat, 0, "$desc testcase did not crash";
 165   is $ret,  1, "$desc compiled fine";
 166  }
 167 }
 168
 169 {
 170  my $desc = 'peephole optimization of map';
 171  my $x;
 172
 173  local $@;
 174  my $code = eval <<' TESTCASE';
 175   no autovivification;
 176   sub {
 177    join ':', map {
 178     my $z = $x->[$_];
 179     "x${_}y"
 180    } @_
 181   }
 182  TESTCASE
 183  is $@, '', "$desc compiled fine";
 184
 185  my $ret = $code->(1, 2);
 186  is_deeply $x, undef,     "$desc did not autovivify";
 187  is      $ret, 'x1y:x2y', "$desc returned the right value";
 188 }
 189
 190 {
 191  my $desc = 'peephole optimization of grep';
 192  my $x;
 193
 194  local $@;
 195  my $code = eval <<' TESTCASE';
 196   no autovivification;
 197   sub {
 198    join ':', grep {
 199     my $z = $x->[$_];
 200     $_ <= 3
 201    } @_
 202   }
 203  TESTCASE
 204  is $@, '', "$desc compiled fine";
 205
 206  my $ret = $code->(1 .. 5);
 207  is_deeply $x, undef,   "$desc did not autovivify";
 208  is      $ret, '1:2:3', "$desc returned the right value";
 209 }
 210
 211 {
 212  my $desc = 'peephole optimization of substitutions';
 213  my $x;
 214
 215  local $@;
 216  my $code = eval <<' TESTCASE';
 217   no autovivification;
 218   sub {
 219    my $str = $_[0];
 220    $str =~ s{
 221     ([0-9])
 222    }{
 223     my $z = $x->[$1];
 224     9 - $1;
 225    }xge;
 226    $str;
 227   }
 228  TESTCASE
 229  is $@, '', "$desc compiled fine";
 230
 231  my $ret = $code->('0123456789');
 232  is_deeply $x, undef,        "$desc did not autovivify";
 233  is      $ret, '9876543210', "$desc returned the right value";
 234 }