[p5sagit/p5-mst-13.2.git] / t / op / range.t

#!./perl

BEGIN {
    chdir 't' if -d 't';
    @INC = ('../lib', '.');
}   
# Avoid using eq_array below as it uses .. internally.
require 'test.pl';

use Config;

plan (135);

is(join(':',1..5), '1:2:3:4:5');

@foo = (1,2,3,4,5,6,7,8,9);
@foo[2..4] = ('c','d','e');

is(join(':',@foo[$foo[0]..5]), '2:c:d:e:6');

@bar[2..4] = ('c','d','e');
is(join(':',@bar[1..5]), ':c:d:e:');

($a,@bcd[0..2],$e) = ('a','b','c','d','e');
is(join(':',$a,@bcd[0..2],$e), 'a:b:c:d:e');

$x = 0;
for (1..100) {
    $x += $_;
}
is($x, 5050);

$x = 0;
for ((100,2..99,1)) {
    $x += $_;
}
is($x, 5050);

$x = join('','a'..'z');
is($x, 'abcdefghijklmnopqrstuvwxyz');

@x = 'A'..'ZZ';
is (scalar @x, 27 * 26);

@x = '09' .. '08';  # should produce '09', '10',... '99' (strange but true)
is(join(",", @x), join(",", map {sprintf "%02d",$_} 9..99));

# same test with foreach (which is a separate implementation)
@y = ();
foreach ('09'..'08') {
    push(@y, $_);
}
is(join(",", @y), join(",", @x));

# check bounds
if ($Config{ivsize} == 8) {
  @a = eval "0x7ffffffffffffffe..0x7fffffffffffffff";
  $a = "9223372036854775806 9223372036854775807";
  @b = eval "-0x7fffffffffffffff..-0x7ffffffffffffffe";
  $b = "-9223372036854775807 -9223372036854775806";
}
else {
  @a = eval "0x7ffffffe..0x7fffffff";
  $a = "2147483646 2147483647";
  @b = eval "-0x7fffffff..-0x7ffffffe";
  $b = "-2147483647 -2147483646";
}

is ("@a", $a);

is ("@b", $b);

# check magic
{
    my $bad = 0;
    local $SIG{'__WARN__'} = sub { $bad = 1 };
    my $x = 'a-e';
    $x =~ s/(\w)-(\w)/join ':', $1 .. $2/e;
    is ($x, 'a:b:c:d:e');
}

# Should use magical autoinc only when both are strings
{
    my $scalar = (() = "0"..-1);
    is ($scalar, 0);
}
{
    my $fail = 0;
    for my $x ("0"..-1) {
	$fail++;
    }
    is ($fail, 0);
}

# [#18165] Should allow "-4".."0", broken by #4730. (AMS 20021031)
is(join(":","-4".."0")     , "-4:-3:-2:-1:0");
is(join(":","-4".."-0")    , "-4:-3:-2:-1:0");
is(join(":","-4\n".."0\n") , "-4:-3:-2:-1:0");
is(join(":","-4\n".."-0\n"), "-4:-3:-2:-1:0");

# undef should be treated as 0 for numerical range
is(join(":",undef..2), '0:1:2');
is(join(":",-2..undef), '-2:-1:0');
is(join(":",undef..'2'), '0:1:2');
is(join(":",'-2'..undef), '-2:-1:0');

# undef should be treated as "" for magical range
is(join(":", map "[$_]", "".."B"), '[]');
is(join(":", map "[$_]", undef.."B"), '[]');
is(join(":", map "[$_]", "B"..""), '');
is(join(":", map "[$_]", "B"..undef), '');

# undef..undef used to segfault
is(join(":", map "[$_]", undef..undef), '[]');

# also test undef in foreach loops
@foo=(); push @foo, $_ for undef..2;
is(join(":", @foo), '0:1:2');

@foo=(); push @foo, $_ for -2..undef;
is(join(":", @foo), '-2:-1:0');

@foo=(); push @foo, $_ for undef..'2';
is(join(":", @foo), '0:1:2');

@foo=(); push @foo, $_ for '-2'..undef;
is(join(":", @foo), '-2:-1:0');

@foo=(); push @foo, $_ for undef.."B";
is(join(":", map "[$_]", @foo), '[]');

@foo=(); push @foo, $_ for "".."B";
is(join(":", map "[$_]", @foo), '[]');

@foo=(); push @foo, $_ for "B"..undef;
is(join(":", map "[$_]", @foo), '');

@foo=(); push @foo, $_ for "B".."";
is(join(":", map "[$_]", @foo), '');

@foo=(); push @foo, $_ for undef..undef;
is(join(":", map "[$_]", @foo), '[]');

# again with magic
{
    my @a = (1..3);
    @foo=(); push @foo, $_ for undef..$#a;
    is(join(":", @foo), '0:1:2');
}
{
    my @a = ();
    @foo=(); push @foo, $_ for $#a..undef;
    is(join(":", @foo), '-1:0');
}
{
    local $1;
    "2" =~ /(.+)/;
    @foo=(); push @foo, $_ for undef..$1;
    is(join(":", @foo), '0:1:2');
}
{
    local $1;
    "-2" =~ /(.+)/;
    @foo=(); push @foo, $_ for $1..undef;
    is(join(":", @foo), '-2:-1:0');
}
{
    local $1;
    "B" =~ /(.+)/;
    @foo=(); push @foo, $_ for undef..$1;
    is(join(":", map "[$_]", @foo), '[]');
}
{
    local $1;
    "B" =~ /(.+)/;
    @foo=(); push @foo, $_ for ""..$1;
    is(join(":", map "[$_]", @foo), '[]');
}
{
    local $1;
    "B" =~ /(.+)/;
    @foo=(); push @foo, $_ for $1..undef;
    is(join(":", map "[$_]", @foo), '');
}
{
    local $1;
    "B" =~ /(.+)/;
    @foo=(); push @foo, $_ for $1.."";
    is(join(":", map "[$_]", @foo), '');
}

# Test upper range limit
my $MAX_INT = ~0>>1;

foreach my $ii (-3 .. 3) {
    my ($first, $last);
    eval {
        my $lim=0;
        for ($MAX_INT-10 .. $MAX_INT+$ii) {
            if (! defined($first)) {
                $first = $_;
            }
            $last = $_;
            last if ($lim++ > 100);   # Protect against integer wrap
        }
    };
    if ($ii <= 0) {
        ok(! $@, 'Upper bound accepted: ' . ($MAX_INT+$ii));
        is($first, $MAX_INT-10, 'Lower bound okay');
        is($last, $MAX_INT+$ii, 'Upper bound okay');
    } else {
        ok($@, 'Upper bound rejected: ' . ($MAX_INT+$ii));
    }
}

foreach my $ii (-3 .. 3) {
    my ($first, $last);
    eval {
        my $lim=0;
        for ($MAX_INT+$ii .. $MAX_INT) {
            if (! defined($first)) {
                $first = $_;
            }
            $last = $_;
            last if ($lim++ > 100);
        }
    };
    if ($ii <= 0) {
        ok(! $@, 'Lower bound accepted: ' . ($MAX_INT+$ii));
        is($first, $MAX_INT+$ii, 'Lower bound okay');
        is($last, $MAX_INT, 'Upper bound okay');
    } else {
        ok($@, 'Lower bound rejected: ' . ($MAX_INT+$ii));
    }
}

{
    my $first;
    eval {
        my $lim=0;
        for ($MAX_INT .. $MAX_INT-1) {
            if (! defined($first)) {
                $first = $_;
            }
            $last = $_;
            last if ($lim++ > 100);
        }
    };
    ok(! $@, 'Range accepted');
    ok(! defined($first), 'Range ineffectual');
}

foreach my $ii (~0, ~0+1, ~0+(~0>>4)) {
    eval {
        my $lim=0;
        for ($MAX_INT-10 .. $ii) {
            last if ($lim++ > 100);
        }
    };
    ok($@, 'Upper bound rejected: ' . $ii);
}

# Test lower range limit
my $MIN_INT = -1-$MAX_INT;

if (! $Config{d_nv_preserves_uv}) {
    # $MIN_INT needs adjustment when IV won't fit into an NV
    my $NV = $MIN_INT - 1;
    my $OFFSET = 1;
    while (($NV + $OFFSET) == $MIN_INT) {
        $OFFSET++
    }
    $MIN_INT += $OFFSET;
}

foreach my $ii (-3 .. 3) {
    my ($first, $last);
    eval {
        my $lim=0;
        for ($MIN_INT+$ii .. $MIN_INT+10) {
            if (! defined($first)) {
                $first = $_;
            }
            $last = $_;
            last if ($lim++ > 100);
        }
    };
    if ($ii >= 0) {
        ok(! $@, 'Lower bound accepted: ' . ($MIN_INT+$ii));
        is($first, $MIN_INT+$ii, 'Lower bound okay');
        is($last, $MIN_INT+10, 'Upper bound okay');
    } else {
        ok($@, 'Lower bound rejected: ' . ($MIN_INT+$ii));
    }
}

foreach my $ii (-3 .. 3) {
    my ($first, $last);
    eval {
        my $lim=0;
        for ($MIN_INT .. $MIN_INT+$ii) {
            if (! defined($first)) {
                $first = $_;
            }
            $last = $_;
            last if ($lim++ > 100);
        }
    };
    if ($ii >= 0) {
        ok(! $@, 'Upper bound accepted: ' . ($MIN_INT+$ii));
        is($first, $MIN_INT, 'Lower bound okay');
        is($last, $MIN_INT+$ii, 'Upper bound okay');
    } else {
        ok($@, 'Upper bound rejected: ' . ($MIN_INT+$ii));
    }
}

{
    my $first;
    eval {
        my $lim=0;
        for ($MIN_INT+1 .. $MIN_INT) {
            if (! defined($first)) {
                $first = $_;
            }
            $last = $_;
            last if ($lim++ > 100);
        }
    };
    ok(! $@, 'Range accepted');
    ok(! defined($first), 'Range ineffectual');
}

foreach my $ii (~0, ~0+1, ~0+(~0>>4)) {
    eval {
        my $lim=0;
        for (-$ii .. $MIN_INT+10) {
            last if ($lim++ > 100);
        }
    };
    ok($@, 'Lower bound rejected: ' . -$ii);
}

# double/tripple magic tests
sub TIESCALAR { bless { value => $_[1], orig => $_[1] } }
sub STORE { $_[0]{store}++; $_[0]{value} = $_[1] }
sub FETCH { $_[0]{fetch}++; $_[0]{value} }
sub stores { tied($_[0])->{value} = tied($_[0])->{orig};
             delete(tied($_[0])->{store}) || 0 }
sub fetches { delete(tied($_[0])->{fetch}) || 0 }
    
tie $x, "main", 6;

my @foo;
@foo = 4 .. $x;
is(scalar @foo, 3);
is("@foo", "4 5 6");
{
  local $TODO = "test for double magic with range operator";
  is(fetches($x), 1);
}
is(stores($x), 0);

@foo = $x .. 8;
is(scalar @foo, 3);
is("@foo", "6 7 8");
{
  local $TODO = "test for double magic with range operator";
  is(fetches($x), 1);
}
is(stores($x), 0);

@foo = $x .. $x + 1;
is(scalar @foo, 2);
is("@foo", "6 7");
{
  local $TODO = "test for double magic with range operator";
  is(fetches($x), 2);
}
is(stores($x), 0);

@foo = ();
for (4 .. $x) {
  push @foo, $_;
}
is(scalar @foo, 3);
is("@foo", "4 5 6");
{
  local $TODO = "test for double magic with range operator";
  is(fetches($x), 1);
}
is(stores($x), 0);

@foo = ();
for (reverse 4 .. $x) {
  push @foo, $_;
}
is(scalar @foo, 3);
is("@foo", "6 5 4");
{
  local $TODO = "test for double magic with range operator";
  is(fetches($x), 1);
}
is(stores($x), 0);

# EOF
Commit	Line	Data
a687059c	1	#!./perl
a687059c	2
4fe3f0fa	3	BEGIN {
4fe3f0fa	4	chdir 't' if -d 't';
4e086238	5	@INC = ('../lib', '.');
4fe3f0fa	6	}
4e086238	7	# Avoid using eq_array below as it uses .. internally.
4e086238	8	require 'test.pl';
4fe3f0fa	9
	10	use Config;
	11
bd1c7bd2	12	plan (135);
a687059c	13
4e086238	14	is(join(':',1..5), '1:2:3:4:5');
a687059c	15
	16	@foo = (1,2,3,4,5,6,7,8,9);
	17	@foo[2..4] = ('c','d','e');
	18
4e086238	19	is(join(':',@foo[$foo[0]..5]), '2:c:d:e:6');
a687059c	20
a687059c	21	@bar[2..4] = ('c','d','e');
4e086238	22	is(join(':',@bar[1..5]), ':c:d:e:');
a687059c	23
a687059c	24	($a,@bcd[0..2],$e) = ('a','b','c','d','e');
4e086238	25	is(join(':',$a,@bcd[0..2],$e), 'a:b:c:d:e');
a687059c	26
	27	$x = 0;
	28	for (1..100) {
	29	$x += $_;
	30	}
4e086238	31	is($x, 5050);
a687059c	32
	33	$x = 0;
	34	for ((100,2..99,1)) {
	35	$x += $_;
	36	}
4e086238	37	is($x, 5050);
0f85fab0	38
0f85fab0	39	$x = join('','a'..'z');
4e086238	40	is($x, 'abcdefghijklmnopqrstuvwxyz');
0f85fab0	41
0f85fab0	42	@x = 'A'..'ZZ';
4e086238	43	is (scalar @x, 27 * 26);
89ea2908	44
89ea2908	45	@x = '09' .. '08'; # should produce '09', '10',... '99' (strange but true)
4e086238	46	is(join(",", @x), join(",", map {sprintf "%02d",$_} 9..99));
89ea2908	47
	48	# same test with foreach (which is a separate implementation)
	49	@y = ();
	50	foreach ('09'..'08') {
	51	push(@y, $_);
	52	}
4e086238	53	is(join(",", @y), join(",", @x));
89ea2908	54
c1ab3db2	55	# check bounds
4fe3f0fa	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
4e086238	69	is ("@a", $a);
c1ab3db2	70
4e086238	71	is ("@b", $b);
c1ab3db2	72
86cb7173	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;
4e086238	79	is ($x, 'a:b:c:d:e');
86cb7173	80	}
39eb4040	81
39eb4040	82	# Should use magical autoinc only when both are strings
4e086238	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);
39eb4040	93	}
545956b7	94
545956b7	95	# [#18165] Should allow "-4".."0", broken by #4730. (AMS 20021031)
4e086238	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");
b0e74086	100
b0e74086	101	# undef should be treated as 0 for numerical range
4e086238	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');
b0e74086	106
b0e74086	107	# undef should be treated as "" for magical range
4e086238	108	is(join(":", map "[$_]", "".."B"), '[]');
	109	is(join(":", map "[$_]", undef.."B"), '[]');
	110	is(join(":", map "[$_]", "B"..""), '');
	111	is(join(":", map "[$_]", "B"..undef), '');
3f63a782	112
076d9a11	113	# undef..undef used to segfault
4e086238	114	is(join(":", map "[$_]", undef..undef), '[]');
3f63a782	115
	116	# also test undef in foreach loops
	117	@foo=(); push @foo, $_ for undef..2;
4e086238	118	is(join(":", @foo), '0:1:2');
3f63a782	119
3f63a782	120	@foo=(); push @foo, $_ for -2..undef;
4e086238	121	is(join(":", @foo), '-2:-1:0');
076d9a11	122
076d9a11	123	@foo=(); push @foo, $_ for undef..'2';
4e086238	124	is(join(":", @foo), '0:1:2');
076d9a11	125
076d9a11	126	@foo=(); push @foo, $_ for '-2'..undef;
4e086238	127	is(join(":", @foo), '-2:-1:0');
3f63a782	128
3f63a782	129	@foo=(); push @foo, $_ for undef.."B";
4e086238	130	is(join(":", map "[$_]", @foo), '[]');
6b75d741	131
6b75d741	132	@foo=(); push @foo, $_ for "".."B";
4e086238	133	is(join(":", map "[$_]", @foo), '[]');
3f63a782	134
3f63a782	135	@foo=(); push @foo, $_ for "B"..undef;
4e086238	136	is(join(":", map "[$_]", @foo), '');
6b75d741	137
6b75d741	138	@foo=(); push @foo, $_ for "B".."";
4e086238	139	is(join(":", map "[$_]", @foo), '');
6b75d741	140
6b75d741	141	@foo=(); push @foo, $_ for undef..undef;
4e086238	142	is(join(":", map "[$_]", @foo), '[]');
984a4bea	143
	144	# again with magic
	145	{
	146	my @a = (1..3);
	147	@foo=(); push @foo, $_ for undef..$#a;
4e086238	148	is(join(":", @foo), '0:1:2');
984a4bea	149	}
	150	{
	151	my @a = ();
	152	@foo=(); push @foo, $_ for $#a..undef;
4e086238	153	is(join(":", @foo), '-1:0');
984a4bea	154	}
	155	{
	156	local $1;
	157	"2" =~ /(.+)/;
	158	@foo=(); push @foo, $_ for undef..$1;
4e086238	159	is(join(":", @foo), '0:1:2');
984a4bea	160	}
	161	{
	162	local $1;
	163	"-2" =~ /(.+)/;
	164	@foo=(); push @foo, $_ for $1..undef;
4e086238	165	is(join(":", @foo), '-2:-1:0');
984a4bea	166	}
	167	{
	168	local $1;
	169	"B" =~ /(.+)/;
	170	@foo=(); push @foo, $_ for undef..$1;
4e086238	171	is(join(":", map "[$_]", @foo), '[]');
984a4bea	172	}
	173	{
	174	local $1;
	175	"B" =~ /(.+)/;
	176	@foo=(); push @foo, $_ for ""..$1;
4e086238	177	is(join(":", map "[$_]", @foo), '[]');
984a4bea	178	}
	179	{
	180	local $1;
	181	"B" =~ /(.+)/;
	182	@foo=(); push @foo, $_ for $1..undef;
4e086238	183	is(join(":", map "[$_]", @foo), '');
984a4bea	184	}
	185	{
	186	local $1;
	187	"B" =~ /(.+)/;
	188	@foo=(); push @foo, $_ for $1.."";
4e086238	189	is(join(":", map "[$_]", @foo), '');
984a4bea	190	}
a2309040	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
bd1c7bd2	344	# double/tripple 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	{
	359	local $TODO = "test for double magic with range operator";
	360	is(fetches($x), 1);
	361	}
	362	is(stores($x), 0);
	363
	364	@foo = $x .. 8;
	365	is(scalar @foo, 3);
	366	is("@foo", "6 7 8");
	367	{
	368	local $TODO = "test for double magic with range operator";
	369	is(fetches($x), 1);
	370	}
	371	is(stores($x), 0);
	372
	373	@foo = $x .. $x + 1;
	374	is(scalar @foo, 2);
	375	is("@foo", "6 7");
	376	{
	377	local $TODO = "test for double magic with range operator";
	378	is(fetches($x), 2);
	379	}
	380	is(stores($x), 0);
	381
	382	@foo = ();
	383	for (4 .. $x) {
	384	push @foo, $_;
	385	}
	386	is(scalar @foo, 3);
	387	is("@foo", "4 5 6");
	388	{
	389	local $TODO = "test for double magic with range operator";
	390	is(fetches($x), 1);
	391	}
	392	is(stores($x), 0);
	393
	394	@foo = ();
	395	for (reverse 4 .. $x) {
	396	push @foo, $_;
	397	}
	398	is(scalar @foo, 3);
	399	is("@foo", "6 5 4");
	400	{
	401	local $TODO = "test for double magic with range operator";
	402	is(fetches($x), 1);
	403	}
	404	is(stores($x), 0);
	405
a2309040	406	# EOF