| 1 | #!./perl |
| 2 | |
| 3 | BEGIN { |
| 4 | chdir 't' if -d 't'; |
| 5 | require './test.pl'; |
| 6 | set_up_inc('../lib', '.'); |
| 7 | } |
| 8 | # Avoid using eq_array below as it uses .. internally. |
| 9 | |
| 10 | use Config; |
| 11 | |
| 12 | plan (141); |
| 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 | } |
| 191 | |
| 192 | # Test upper range limit |
| 193 | my $MAX_INT = ~0>>1; |
| 194 | |
| 195 | foreach 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 | |
| 216 | foreach 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 | |
| 253 | foreach 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 |
| 264 | my $MIN_INT = -1-$MAX_INT; |
| 265 | |
| 266 | if (! $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 | |
| 276 | foreach 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 | |
| 297 | foreach 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 | |
| 334 | foreach 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/triple magic tests |
| 345 | sub TIESCALAR { bless { value => $_[1], orig => $_[1] } } |
| 346 | sub STORE { $_[0]{store}++; $_[0]{value} = $_[1] } |
| 347 | sub FETCH { $_[0]{fetch}++; $_[0]{value} } |
| 348 | sub stores { tied($_[0])->{value} = tied($_[0])->{orig}; |
| 349 | delete(tied($_[0])->{store}) || 0 } |
| 350 | sub fetches { delete(tied($_[0])->{fetch}) || 0 } |
| 351 | |
| 352 | tie $x, "main", 6; |
| 353 | |
| 354 | my @foo; |
| 355 | @foo = 4 .. $x; |
| 356 | is(scalar @foo, 3); |
| 357 | is("@foo", "4 5 6"); |
| 358 | is(fetches($x), 1); |
| 359 | is(stores($x), 0); |
| 360 | |
| 361 | @foo = $x .. 8; |
| 362 | is(scalar @foo, 3); |
| 363 | is("@foo", "6 7 8"); |
| 364 | is(fetches($x), 1); |
| 365 | is(stores($x), 0); |
| 366 | |
| 367 | @foo = $x .. $x + 1; |
| 368 | is(scalar @foo, 2); |
| 369 | is("@foo", "6 7"); |
| 370 | is(fetches($x), 2); |
| 371 | is(stores($x), 0); |
| 372 | |
| 373 | @foo = (); |
| 374 | for (4 .. $x) { |
| 375 | push @foo, $_; |
| 376 | } |
| 377 | is(scalar @foo, 3); |
| 378 | is("@foo", "4 5 6"); |
| 379 | is(fetches($x), 1); |
| 380 | is(stores($x), 0); |
| 381 | |
| 382 | @foo = (); |
| 383 | for (reverse 4 .. $x) { |
| 384 | push @foo, $_; |
| 385 | } |
| 386 | is(scalar @foo, 3); |
| 387 | is("@foo", "6 5 4"); |
| 388 | is(fetches($x), 1); |
| 389 | is(stores($x), 0); |
| 390 | |
| 391 | is( ( join ' ', map { join '', map ++$_, ($x=1)..4 } 1..2 ), '2345 2345', |
| 392 | 'modifiable variable num range' ); |
| 393 | is( ( join ' ', map { join '', map ++$_, 1..4 } 1..2 ), '2345 2345', |
| 394 | 'modifiable const num range' ); # RT#3105 |
| 395 | $s = ''; for (1..2) { for (1..4) { $s .= ++$_ } $s.=' ' if $_==1; } |
| 396 | is( $s, '2345 2345','modifiable num counting loop counter' ); |
| 397 | |
| 398 | |
| 399 | is( ( join ' ', map { join '', map ++$_, ($x='a')..'d' } 1..2 ), 'bcde bcde', |
| 400 | 'modifiable variable alpha range' ); |
| 401 | is( ( join ' ', map { join '', map ++$_, 'a'..'d' } 1..2 ), 'bcde bcde', |
| 402 | 'modifiable const alpha range' ); # RT#3105 |
| 403 | $s = ''; for (1..2) { for ('a'..'d') { $s .= ++$_ } $s.=' ' if $_==1; } |
| 404 | is( $s, 'bcde bcde','modifiable alpha counting loop counter' ); |
| 405 | |
| 406 | # EOF |