From: Jerry D. Hedden <jdhedden@cpan.org>
Date: Mon, 14 Jan 2008 19:56:48 +0000 (-0500)
Subject: Fix range operator
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a2309040b8fe324ae09c064137c624b4292d93c1;p=p5sagit%2Fp5-mst-13.2.git

Fix range operator
From: "Jerry D. Hedden" <jdhedden@cpan.org>
Message-ID: <1ff86f510801141656i325ac69ev8a0af47f9fe72a1e@mail.gmail.com>

p4raw-id: //depot/perl@32979
---

diff --git a/pp_ctl.c b/pp_ctl.c
index 5cc002c..c596fdb 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1873,8 +1873,25 @@ PP(pp_enteriter)
 	    SvGETMAGIC(sv);
 	    SvGETMAGIC(right);
 	    if (RANGE_IS_NUMERIC(sv,right)) {
-		if ((SvOK(sv) && SvNV(sv) < IV_MIN) ||
-		    (SvOK(right) && SvNV(right) >= IV_MAX))
+#ifdef NV_PRESERVES_UV
+		if ((SvOK(sv) && ((SvNV(sv) < (NV)IV_MIN) ||
+				  (SvNV(sv) > (NV)IV_MAX)))
+			||
+		    (SvOK(right) && ((SvNV(right) > (NV)IV_MAX) ||
+				     (SvNV(right) < (NV)IV_MIN))))
+#else
+		if ((SvOK(sv) && ((SvNV(sv) <= (NV)IV_MIN)
+				  ||
+		                  ((SvNV(sv) > 0) &&
+					((SvUV(sv) > (UV)IV_MAX) ||
+					 (SvNV(sv) > (NV)UV_MAX)))))
+			||
+		    (SvOK(right) && ((SvNV(right) <= (NV)IV_MIN)
+				     ||
+				     ((SvNV(right) > 0) &&
+					((SvUV(right) > (UV)IV_MAX) ||
+					 (SvNV(right) > (NV)UV_MAX))))))
+#endif
 		    DIE(aTHX_ "Range iterator outside integer range");
 		cx->blk_loop.iterix = SvIV(sv);
 		cx->blk_loop.itermax = SvIV(right);
diff --git a/pp_hot.c b/pp_hot.c
index 2cb394e..ad9e0ea 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1961,6 +1961,15 @@ PP(pp_iter)
 	    *itersvp = newSViv(cx->blk_loop.iterix++);
 	    SvREFCNT_dec(oldsv);
 	}
+
+	/* Handle end of range at IV_MAX */
+	if ((cx->blk_loop.iterix == IV_MIN) &&
+	    (cx->blk_loop.itermax == IV_MAX))
+	{
+	    cx->blk_loop.iterix++;
+	    cx->blk_loop.itermax++;
+	}
+
 	RETPUSHYES;
     }
 
diff --git a/t/op/range.t b/t/op/range.t
index 3cef292..6759f88 100755
--- a/t/op/range.t
+++ b/t/op/range.t
@@ -9,7 +9,7 @@ require 'test.pl';
 
 use Config;
 
-plan (45);
+plan (115);
 
 is(join(':',1..5), '1:2:3:4:5');
 
@@ -188,3 +188,157 @@ is(join(":", map "[$_]", @foo), '[]');
     @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);
+}
+
+# EOF