t/43-peep.t

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