Repent and make overly large integerish

constants non-fatal.  They are now promoted
to NVs, accompanied by an overflow warning that
is by default on.

p4raw-id: //depot/cfgperl@3832

1 files changed, 64 insertions, 13 deletions

diff --git a/toke.c b/toke.c
index 6f792f21d5..d02ac5a67d 100644
--- a/toke.c
+++ b/toke.c
@@ -6285,8 +6285,21 @@ Perl_scan_num(pTHX_ char *start)
 	     when in octal mode.
 	   */
     	    dTHR;
-	    UV u;
+	    NV n = 0.0;
+	    UV u = 0;
 	    I32 shift;
+	    bool overflowed = FALSE;
+	    static NV nvshift[5] = { 1.0, 2.0, 4.0, 8.0, 16.0 };
+	    static char* bases[5] = { "", "binary", "", "octal",
+				      "hexadecimal" };
+	    static char* Bases[5] = { "", "Binary", "", "Octal",
+				      "Hexadecimal" };
+	    static char *maxima[5] = { "",
+				       "0b11111111111111111111111111111111",
+				       "",
+				       "0b37777777777",
+				       "0xffffffff" };
+	    char *base, *Base, *max;
 
 	    /* check for hex */
 	    if (s[1] == 'x') {
@@ -6302,11 +6315,16 @@ Perl_scan_num(pTHX_ char *start)
 	    /* so it must be octal */
 	    else
 		shift = 3;
-	    u = 0;
+
+	    base = bases[shift];
+	    Base = Bases[shift];
+	    max  = maxima[shift];
 
 	    /* read the rest of the number */
 	    for (;;) {
-		UV n, b;	/* n is used in the overflow test, b is the digit we're adding on */
+		/* x is used in the overflow test,
+		   b is the digit we're adding on */
+		UV x, b;
 
 		switch (*s) {
 
@@ -6352,16 +6370,34 @@ Perl_scan_num(pTHX_ char *start)
 		    */
 
 		  digit:
-		    n = u << shift;	/* make room for the digit */
-		    if ((n >> shift) != u
-			&& !(PL_hints & HINT_NEW_BINARY))
-		    {
-			Perl_croak(aTHX_
-				   "Integer overflow in %s number",
-				   (shift == 4) ? "hexadecimal"
-				   : ((shift == 3) ? "octal" : "binary"));
+		    if (!overflowed) {
+			x = u << shift;	/* make room for the digit */
+
+			if ((x >> shift) != u
+			    && !(PL_hints & HINT_NEW_BINARY)) {
+			    dTHR;
+			    overflowed = TRUE;
+			    n = (NV) u;
+			    if (ckWARN_d(WARN_UNSAFE))
+				Perl_warner(aTHX_ ((shift == 3) ?
+						   WARN_OCTAL : WARN_UNSAFE),
+					    "Integer overflow in %s number",
+					    base);
+			} else
+			    u = x | b;		/* add the digit to the end */
+		    }
+		    if (overflowed) {
+			n *= nvshift[shift];
+			/* If an NV has not enough bits in its
+			 * mantissa to represent an UV this summing of
+			 * small low-order numbers is a waste of time
+			 * (because the NV cannot preserve the
+			 * low-order bits anyway): we could just
+			 * remember when did we overflow and in the
+			 * end just multiply n by the right
+			 * amount. */
+			n += (NV) b;
 		    }
-		    u = n | b;		/* add the digit to the end */
 		    break;
 		}
 	    }
@@ -6371,7 +6407,22 @@ Perl_scan_num(pTHX_ char *start)
 	  */
 	  out:
 	    sv = NEWSV(92,0);
-	    sv_setuv(sv, u);
+	    if (overflowed) {
+		dTHR;
+		if (ckWARN(WARN_UNSAFE) && (double) n > 4294967295.0)
+		    Perl_warner(aTHX_ WARN_UNSAFE,
+				"%s number > %s non-portable",
+				Base, max);
+		sv_setnv(sv, n);
+	    }
+	    else {
+		dTHR;
+		if (ckWARN(WARN_UNSAFE) && u > 4294967295)
+		    Perl_warner(aTHX_ WARN_UNSAFE,
+				"%s number > %s non-portable",
+				Base, max);
+		sv_setuv(sv, u);
+	    }
 	    if ( PL_hints & HINT_NEW_BINARY)
 		sv = new_constant(start, s - start, "binary", sv, Nullsv, NULL);
 	}