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 (file)
--- 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 (file)
--- 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 (executable)
--- 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