t/op/range.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = ('../lib', '.');
   6 }
   7 # Avoid using eq_array below as it uses .. internally.
   8 require 'test.pl';
   9
  10 use Config;
  11
  12 plan (45);
  13
  14 is(join(':',1..5), '1:2:3:4:5');
  15
  16 @foo = (1,2,3,4,5,6,7,8,9);
  17 @foo[2..4] = ('c','d','e');
  18
  19 is(join(':',@foo[$foo[0]..5]), '2:c:d:e:6');
  20
  21 @bar[2..4] = ('c','d','e');
  22 is(join(':',@bar[1..5]), ':c:d:e:');
  23
  24 ($a,@bcd[0..2],$e) = ('a','b','c','d','e');
  25 is(join(':',$a,@bcd[0..2],$e), 'a:b:c:d:e');
  26
  27 $x = 0;
  28 for (1..100) {
  29     $x += $_;
  30 }
  31 is($x, 5050);
  32
  33 $x = 0;
  34 for ((100,2..99,1)) {
  35     $x += $_;
  36 }
  37 is($x, 5050);
  38
  39 $x = join('','a'..'z');
  40 is($x, 'abcdefghijklmnopqrstuvwxyz');
  41
  42 @x = 'A'..'ZZ';
  43 is (scalar @x, 27 * 26);
  44
  45 @x = '09' .. '08';  # should produce '09', '10',... '99' (strange but true)
  46 is(join(",", @x), join(",", map {sprintf "%02d",$_} 9..99));
  47
  48 # same test with foreach (which is a separate implementation)
  49 @y = ();
  50 foreach ('09'..'08') {
  51     push(@y, $_);
  52 }
  53 is(join(",", @y), join(",", @x));
  54
  55 # check bounds
  56 if ($Config{ivsize} == 8) {
  57   @a = eval "0x7ffffffffffffffe..0x7fffffffffffffff";
  58   $a = "9223372036854775806 9223372036854775807";
  59   @b = eval "-0x7fffffffffffffff..-0x7ffffffffffffffe";
  60   $b = "-9223372036854775807 -9223372036854775806";
  61 }
  62 else {
  63   @a = eval "0x7ffffffe..0x7fffffff";
  64   $a = "2147483646 2147483647";
  65   @b = eval "-0x7fffffff..-0x7ffffffe";
  66   $b = "-2147483647 -2147483646";
  67 }
  68
  69 is ("@a", $a);
  70
  71 is ("@b", $b);
  72
  73 # check magic
  74 {
  75     my $bad = 0;
  76     local $SIG{'__WARN__'} = sub { $bad = 1 };
  77     my $x = 'a-e';
  78     $x =~ s/(\w)-(\w)/join ':', $1 .. $2/e;
  79     is ($x, 'a:b:c:d:e');
  80 }
  81
  82 # Should use magical autoinc only when both are strings
  83 {
  84     my $scalar = (() = "0"..-1);
  85     is ($scalar, 0);
  86 }
  87 {
  88     my $fail = 0;
  89     for my $x ("0"..-1) {
  90         $fail++;
  91     }
  92     is ($fail, 0);
  93 }
  94
  95 # [#18165] Should allow "-4".."0", broken by #4730. (AMS 20021031)
  96 is(join(":","-4".."0")     , "-4:-3:-2:-1:0");
  97 is(join(":","-4".."-0")    , "-4:-3:-2:-1:0");
  98 is(join(":","-4\n".."0\n") , "-4:-3:-2:-1:0");
  99 is(join(":","-4\n".."-0\n"), "-4:-3:-2:-1:0");
 100
 101 # undef should be treated as 0 for numerical range
 102 is(join(":",undef..2), '0:1:2');
 103 is(join(":",-2..undef), '-2:-1:0');
 104 is(join(":",undef..'2'), '0:1:2');
 105 is(join(":",'-2'..undef), '-2:-1:0');
 106
 107 # undef should be treated as "" for magical range
 108 is(join(":", map "[$_]", "".."B"), '[]');
 109 is(join(":", map "[$_]", undef.."B"), '[]');
 110 is(join(":", map "[$_]", "B"..""), '');
 111 is(join(":", map "[$_]", "B"..undef), '');
 112
 113 # undef..undef used to segfault
 114 is(join(":", map "[$_]", undef..undef), '[]');
 115
 116 # also test undef in foreach loops
 117 @foo=(); push @foo, $_ for undef..2;
 118 is(join(":", @foo), '0:1:2');
 119
 120 @foo=(); push @foo, $_ for -2..undef;
 121 is(join(":", @foo), '-2:-1:0');
 122
 123 @foo=(); push @foo, $_ for undef..'2';
 124 is(join(":", @foo), '0:1:2');
 125
 126 @foo=(); push @foo, $_ for '-2'..undef;
 127 is(join(":", @foo), '-2:-1:0');
 128
 129 @foo=(); push @foo, $_ for undef.."B";
 130 is(join(":", map "[$_]", @foo), '[]');
 131
 132 @foo=(); push @foo, $_ for "".."B";
 133 is(join(":", map "[$_]", @foo), '[]');
 134
 135 @foo=(); push @foo, $_ for "B"..undef;
 136 is(join(":", map "[$_]", @foo), '');
 137
 138 @foo=(); push @foo, $_ for "B".."";
 139 is(join(":", map "[$_]", @foo), '');
 140
 141 @foo=(); push @foo, $_ for undef..undef;
 142 is(join(":", map "[$_]", @foo), '[]');
 143
 144 # again with magic
 145 {
 146     my @a = (1..3);
 147     @foo=(); push @foo, $_ for undef..$#a;
 148     is(join(":", @foo), '0:1:2');
 149 }
 150 {
 151     my @a = ();
 152     @foo=(); push @foo, $_ for $#a..undef;
 153     is(join(":", @foo), '-1:0');
 154 }
 155 {
 156     local $1;
 157     "2" =~ /(.+)/;
 158     @foo=(); push @foo, $_ for undef..$1;
 159     is(join(":", @foo), '0:1:2');
 160 }
 161 {
 162     local $1;
 163     "-2" =~ /(.+)/;
 164     @foo=(); push @foo, $_ for $1..undef;
 165     is(join(":", @foo), '-2:-1:0');
 166 }
 167 {
 168     local $1;
 169     "B" =~ /(.+)/;
 170     @foo=(); push @foo, $_ for undef..$1;
 171     is(join(":", map "[$_]", @foo), '[]');
 172 }
 173 {
 174     local $1;
 175     "B" =~ /(.+)/;
 176     @foo=(); push @foo, $_ for ""..$1;
 177     is(join(":", map "[$_]", @foo), '[]');
 178 }
 179 {
 180     local $1;
 181     "B" =~ /(.+)/;
 182     @foo=(); push @foo, $_ for $1..undef;
 183     is(join(":", map "[$_]", @foo), '');
 184 }
 185 {
 186     local $1;
 187     "B" =~ /(.+)/;
 188     @foo=(); push @foo, $_ for $1.."";
 189     is(join(":", map "[$_]", @foo), '');
 190 }