t/17-peep.t

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