1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 @INC = ('../lib', '.'); 6} 7# Avoid using eq_array below as it uses .. internally. 8require 'test.pl'; 9 10use Config; 11 12plan (135); 13 14is(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 19is(join(':',@foo[$foo[0]..5]), '2:c:d:e:6'); 20 21@bar[2..4] = ('c','d','e'); 22is(join(':',@bar[1..5]), ':c:d:e:'); 23 24($a,@bcd[0..2],$e) = ('a','b','c','d','e'); 25is(join(':',$a,@bcd[0..2],$e), 'a:b:c:d:e'); 26 27$x = 0; 28for (1..100) { 29 $x += $_; 30} 31is($x, 5050); 32 33$x = 0; 34for ((100,2..99,1)) { 35 $x += $_; 36} 37is($x, 5050); 38 39$x = join('','a'..'z'); 40is($x, 'abcdefghijklmnopqrstuvwxyz'); 41 42@x = 'A'..'ZZ'; 43is (scalar @x, 27 * 26); 44 45@x = '09' .. '08'; # should produce '09', '10',... '99' (strange but true) 46is(join(",", @x), join(",", map {sprintf "%02d",$_} 9..99)); 47 48# same test with foreach (which is a separate implementation) 49@y = (); 50foreach ('09'..'08') { 51 push(@y, $_); 52} 53is(join(",", @y), join(",", @x)); 54 55# check bounds 56if ($Config{ivsize} == 8) { 57 @a = eval "0x7ffffffffffffffe..0x7fffffffffffffff"; 58 $a = "9223372036854775806 9223372036854775807"; 59 @b = eval "-0x7fffffffffffffff..-0x7ffffffffffffffe"; 60 $b = "-9223372036854775807 -9223372036854775806"; 61} 62else { 63 @a = eval "0x7ffffffe..0x7fffffff"; 64 $a = "2147483646 2147483647"; 65 @b = eval "-0x7fffffff..-0x7ffffffe"; 66 $b = "-2147483647 -2147483646"; 67} 68 69is ("@a", $a); 70 71is ("@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) 96is(join(":","-4".."0") , "-4:-3:-2:-1:0"); 97is(join(":","-4".."-0") , "-4:-3:-2:-1:0"); 98is(join(":","-4\n".."0\n") , "-4:-3:-2:-1:0"); 99is(join(":","-4\n".."-0\n"), "-4:-3:-2:-1:0"); 100 101# undef should be treated as 0 for numerical range 102is(join(":",undef..2), '0:1:2'); 103is(join(":",-2..undef), '-2:-1:0'); 104is(join(":",undef..'2'), '0:1:2'); 105is(join(":",'-2'..undef), '-2:-1:0'); 106 107# undef should be treated as "" for magical range 108is(join(":", map "[$_]", "".."B"), '[]'); 109is(join(":", map "[$_]", undef.."B"), '[]'); 110is(join(":", map "[$_]", "B"..""), ''); 111is(join(":", map "[$_]", "B"..undef), ''); 112 113# undef..undef used to segfault 114is(join(":", map "[$_]", undef..undef), '[]'); 115 116# also test undef in foreach loops 117@foo=(); push @foo, $_ for undef..2; 118is(join(":", @foo), '0:1:2'); 119 120@foo=(); push @foo, $_ for -2..undef; 121is(join(":", @foo), '-2:-1:0'); 122 123@foo=(); push @foo, $_ for undef..'2'; 124is(join(":", @foo), '0:1:2'); 125 126@foo=(); push @foo, $_ for '-2'..undef; 127is(join(":", @foo), '-2:-1:0'); 128 129@foo=(); push @foo, $_ for undef.."B"; 130is(join(":", map "[$_]", @foo), '[]'); 131 132@foo=(); push @foo, $_ for "".."B"; 133is(join(":", map "[$_]", @foo), '[]'); 134 135@foo=(); push @foo, $_ for "B"..undef; 136is(join(":", map "[$_]", @foo), ''); 137 138@foo=(); push @foo, $_ for "B"..""; 139is(join(":", map "[$_]", @foo), ''); 140 141@foo=(); push @foo, $_ for undef..undef; 142is(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} 191 192# Test upper range limit 193my $MAX_INT = ~0>>1; 194 195foreach my $ii (-3 .. 3) { 196 my ($first, $last); 197 eval { 198 my $lim=0; 199 for ($MAX_INT-10 .. $MAX_INT+$ii) { 200 if (! defined($first)) { 201 $first = $_; 202 } 203 $last = $_; 204 last if ($lim++ > 100); # Protect against integer wrap 205 } 206 }; 207 if ($ii <= 0) { 208 ok(! $@, 'Upper bound accepted: ' . ($MAX_INT+$ii)); 209 is($first, $MAX_INT-10, 'Lower bound okay'); 210 is($last, $MAX_INT+$ii, 'Upper bound okay'); 211 } else { 212 ok($@, 'Upper bound rejected: ' . ($MAX_INT+$ii)); 213 } 214} 215 216foreach my $ii (-3 .. 3) { 217 my ($first, $last); 218 eval { 219 my $lim=0; 220 for ($MAX_INT+$ii .. $MAX_INT) { 221 if (! defined($first)) { 222 $first = $_; 223 } 224 $last = $_; 225 last if ($lim++ > 100); 226 } 227 }; 228 if ($ii <= 0) { 229 ok(! $@, 'Lower bound accepted: ' . ($MAX_INT+$ii)); 230 is($first, $MAX_INT+$ii, 'Lower bound okay'); 231 is($last, $MAX_INT, 'Upper bound okay'); 232 } else { 233 ok($@, 'Lower bound rejected: ' . ($MAX_INT+$ii)); 234 } 235} 236 237{ 238 my $first; 239 eval { 240 my $lim=0; 241 for ($MAX_INT .. $MAX_INT-1) { 242 if (! defined($first)) { 243 $first = $_; 244 } 245 $last = $_; 246 last if ($lim++ > 100); 247 } 248 }; 249 ok(! $@, 'Range accepted'); 250 ok(! defined($first), 'Range ineffectual'); 251} 252 253foreach my $ii (~0, ~0+1, ~0+(~0>>4)) { 254 eval { 255 my $lim=0; 256 for ($MAX_INT-10 .. $ii) { 257 last if ($lim++ > 100); 258 } 259 }; 260 ok($@, 'Upper bound rejected: ' . $ii); 261} 262 263# Test lower range limit 264my $MIN_INT = -1-$MAX_INT; 265 266if (! $Config{d_nv_preserves_uv}) { 267 # $MIN_INT needs adjustment when IV won't fit into an NV 268 my $NV = $MIN_INT - 1; 269 my $OFFSET = 1; 270 while (($NV + $OFFSET) == $MIN_INT) { 271 $OFFSET++ 272 } 273 $MIN_INT += $OFFSET; 274} 275 276foreach my $ii (-3 .. 3) { 277 my ($first, $last); 278 eval { 279 my $lim=0; 280 for ($MIN_INT+$ii .. $MIN_INT+10) { 281 if (! defined($first)) { 282 $first = $_; 283 } 284 $last = $_; 285 last if ($lim++ > 100); 286 } 287 }; 288 if ($ii >= 0) { 289 ok(! $@, 'Lower bound accepted: ' . ($MIN_INT+$ii)); 290 is($first, $MIN_INT+$ii, 'Lower bound okay'); 291 is($last, $MIN_INT+10, 'Upper bound okay'); 292 } else { 293 ok($@, 'Lower bound rejected: ' . ($MIN_INT+$ii)); 294 } 295} 296 297foreach my $ii (-3 .. 3) { 298 my ($first, $last); 299 eval { 300 my $lim=0; 301 for ($MIN_INT .. $MIN_INT+$ii) { 302 if (! defined($first)) { 303 $first = $_; 304 } 305 $last = $_; 306 last if ($lim++ > 100); 307 } 308 }; 309 if ($ii >= 0) { 310 ok(! $@, 'Upper bound accepted: ' . ($MIN_INT+$ii)); 311 is($first, $MIN_INT, 'Lower bound okay'); 312 is($last, $MIN_INT+$ii, 'Upper bound okay'); 313 } else { 314 ok($@, 'Upper bound rejected: ' . ($MIN_INT+$ii)); 315 } 316} 317 318{ 319 my $first; 320 eval { 321 my $lim=0; 322 for ($MIN_INT+1 .. $MIN_INT) { 323 if (! defined($first)) { 324 $first = $_; 325 } 326 $last = $_; 327 last if ($lim++ > 100); 328 } 329 }; 330 ok(! $@, 'Range accepted'); 331 ok(! defined($first), 'Range ineffectual'); 332} 333 334foreach my $ii (~0, ~0+1, ~0+(~0>>4)) { 335 eval { 336 my $lim=0; 337 for (-$ii .. $MIN_INT+10) { 338 last if ($lim++ > 100); 339 } 340 }; 341 ok($@, 'Lower bound rejected: ' . -$ii); 342} 343 344# double/tripple magic tests 345sub TIESCALAR { bless { value => $_[1], orig => $_[1] } } 346sub STORE { $_[0]{store}++; $_[0]{value} = $_[1] } 347sub FETCH { $_[0]{fetch}++; $_[0]{value} } 348sub stores { tied($_[0])->{value} = tied($_[0])->{orig}; 349 delete(tied($_[0])->{store}) || 0 } 350sub fetches { delete(tied($_[0])->{fetch}) || 0 } 351 352tie $x, "main", 6; 353 354my @foo; 355@foo = 4 .. $x; 356is(scalar @foo, 3); 357is("@foo", "4 5 6"); 358{ 359 local $TODO = "test for double magic with range operator"; 360 is(fetches($x), 1); 361} 362is(stores($x), 0); 363 364@foo = $x .. 8; 365is(scalar @foo, 3); 366is("@foo", "6 7 8"); 367{ 368 local $TODO = "test for double magic with range operator"; 369 is(fetches($x), 1); 370} 371is(stores($x), 0); 372 373@foo = $x .. $x + 1; 374is(scalar @foo, 2); 375is("@foo", "6 7"); 376{ 377 local $TODO = "test for double magic with range operator"; 378 is(fetches($x), 2); 379} 380is(stores($x), 0); 381 382@foo = (); 383for (4 .. $x) { 384 push @foo, $_; 385} 386is(scalar @foo, 3); 387is("@foo", "4 5 6"); 388{ 389 local $TODO = "test for double magic with range operator"; 390 is(fetches($x), 1); 391} 392is(stores($x), 0); 393 394@foo = (); 395for (reverse 4 .. $x) { 396 push @foo, $_; 397} 398is(scalar @foo, 3); 399is("@foo", "6 5 4"); 400{ 401 local $TODO = "test for double magic with range operator"; 402 is(fetches($x), 1); 403} 404is(stores($x), 0); 405 406# EOF 407