develooper Front page | perl.perl5.porters | Postings from July 2001

[PATCH] Re: op/arith.t

Thread Previous | Thread Next
From:
Nicholas Clark
Date:
July 7, 2001 05:05
Subject:
[PATCH] Re: op/arith.t
Message ID:
20010707130454.D59620@plum.flirble.org
On Fri, Jul 06, 2001 at 05:20:53PM -0400, Norton Allen wrote:
> Nicholas Clark wrote:
> > My hunch is that your strtol isn't setting errno correctly.
> 
>   strtol() is OK: It's strtoul that doesn't set errno.

The appended patch makes toke.c use grok_number rather than strtol and
strtoul [or atol()], which removes some more conditionally compiled code
from perl.
I found I hadn't quite got the length checking code in grok_number correct,
hence the patch to numeric.c
I think it's correct now - I tested it with the following program

#include "EXTERN.h"
#include "perl.h"

int main (int argc, char **argv) {
  while (*++argv) {
    int i;
    PerlIO_printf(PerlIO_stdout(), "'%s'\n", *argv);
    for (i = strlen (*argv); i; i--) {
      UV val;
      int flags = grok_number (*argv, i, &val);
      if (flags & IS_NUMBER_IN_UV) {
        PerlIO_printf(PerlIO_stdout(), "%2d, %X, %" UVuf "\n", i, flags, val);
      } else {
        PerlIO_printf(PerlIO_stdout(), "%2d, %X\n", i, flags);
      }
    }
  }
  return 0;
}

Which now gives happy output looking like this:

'42949672960'
11, 2, 4
10, 2, 4
9, 1, 429496729
8, 1, 42949672
7, 1, 4294967
6, 1, 429496
5, 1, 42949
4, 1, 4294
3, 1, 429
2, 1, 42
1, 1, 4


[tested on 32 and 64 bit builds]

Nicholas Clark

--- toke.c.orig	Fri Jul  6 03:15:58 2001
+++ toke.c	Sat Jul  7 00:37:17 2001
@@ -7211,91 +7211,39 @@
 	    }
 	}
 
-	/* terminate the string */
-	*d = '\0';
 
 	/* make an sv from the string */
 	sv = NEWSV(92,0);
 
-#if defined(Strtol) && defined(Strtoul)
-
 	/*
-	   strtol/strtoll sets errno to ERANGE if the number is too big
-	   for an integer. We try to do an integer conversion first
-	   if no characters indicating "float" have been found.
+           We try to do an integer conversion first if no characters
+           indicating "float" have been found.
 	 */
 
 	if (!floatit) {
-    	    IV iv = 0;
-    	    UV uv = 0;
-	    errno = 0;
-	    if (*PL_tokenbuf == '-')
-		iv = Strtol(PL_tokenbuf, (char**)NULL, 10);
-	    else
-		uv = Strtoul(PL_tokenbuf, (char**)NULL, 10);
-	    if (errno)
-	    	floatit = TRUE; /* Probably just too large. */
-	    else if (*PL_tokenbuf == '-')
-	    	sv_setiv(sv, iv);
-	    else if (uv <= IV_MAX)
+    	    UV uv;
+            int flags = grok_number (PL_tokenbuf, d - PL_tokenbuf, &uv);
+
+            if (flags == IS_NUMBER_IN_UV) {
+              if (uv <= IV_MAX)
 		sv_setiv(sv, uv); /* Prefer IVs over UVs. */
-	    else
+              else
 	    	sv_setuv(sv, uv);
-	}
+            } else if (flags == (IS_NUMBER_IN_UV | IS_NUMBER_NEG)) {
+              if (uv <= (UV) IV_MIN)
+                sv_setiv(sv, -(IV)uv);
+              else
+	    	floatit = TRUE;
+            } else
+              floatit = TRUE;
+        }
 	if (floatit) {
+	    /* terminate the string */
+	    *d = '\0';
 	    nv = Atof(PL_tokenbuf);
 	    sv_setnv(sv, nv);
 	}
-#else
-	/*
-	   No working strtou?ll?.
-
-	   Unfortunately atol() doesn't do range checks (returning
-	   LONG_MIN/LONG_MAX, and setting errno to ERANGE on overflows)
-	   everywhere [1], so we cannot use use atol() (or atoll()).
-	   If we could, they would be used, as Atol(), very much like
-	   Strtol() and Strtoul() are used above.
-
-	   [1] XXX Configure test needed to check for atol()
-	           (and atoll()) overflow behaviour XXX
 
-	   --jhi
-
-	   We need to do this the hard way.  */
-
-	nv = Atof(PL_tokenbuf);
-
-	/* See if we can make do with an integer value without loss of
-	   precision.  We use U_V to cast to a UV, because some
-	   compilers have issues.  Then we try casting it back and see
-	   if it was the same [1].  We only do this if we know we
-	   specifically read an integer.  If floatit is true, then we
-	   don't need to do the conversion at all.
-
-	   [1] Note that this is lossy if our NVs cannot preserve our
-	   UVs.  There are metaconfig defines NV_PRESERVES_UV (a boolean)
-	   and NV_PRESERVES_UV_BITS (a number), but in general we really
-	   do hope all such potentially lossy platforms have strtou?ll?
-	   to do a lossless IV/UV conversion.
-
-	   Maybe could do some tricks with DBL_DIG, LDBL_DIG and
-	   DBL_MANT_DIG and LDBL_MANT_DIG (these are already available
-	   as NV_DIG and NV_MANT_DIG)?
-	
-	   --jhi
-	   */
-	{
-	    UV uv = U_V(nv);
-	    if (!floatit && (NV)uv == nv) {
-		if (uv <= IV_MAX)
-		    sv_setiv(sv, uv); /* Prefer IVs over UVs. */
-		else
-		    sv_setuv(sv, uv);
-	    }
-	    else
-		sv_setnv(sv, nv);
-	}
-#endif
 	if ( floatit ? (PL_hints & HINT_NEW_FLOAT) :
 	               (PL_hints & HINT_NEW_INTEGER) )
 	    sv = new_constant(PL_tokenbuf, d - PL_tokenbuf,
--- numeric.c.orig	Tue Jul  3 00:57:28 2001
+++ numeric.c	Sat Jul  7 00:39:54 2001
@@ -401,49 +401,49 @@
        With it gcc on arm is managing 6 instructions (6 cycles) per digit.
        In theory the optimiser could deduce how far to unroll the loop
        before checking for overflow.  */
-    if (s < send) {
-      int digit = *++s - '0';
+    if (++s < send) {
+      int digit = *s - '0';
       if (digit >= 0 && digit <= 9) {
         value = value * 10 + digit;
-        if (s < send) {
-          digit = *++s - '0';
+        if (++s < send) {
+          digit = *s - '0';
           if (digit >= 0 && digit <= 9) {
             value = value * 10 + digit;
-            if (s < send) {
-              digit = *++s - '0';
+            if (++s < send) {
+              digit = *s - '0';
               if (digit >= 0 && digit <= 9) {
                 value = value * 10 + digit;
-		if (s < send) {
-                  digit = *++s - '0';
+		if (++s < send) {
+                  digit = *s - '0';
                   if (digit >= 0 && digit <= 9) {
                     value = value * 10 + digit;
-                    if (s < send) {
-                      digit = *++s - '0';
+                    if (++s < send) {
+                      digit = *s - '0';
                       if (digit >= 0 && digit <= 9) {
                         value = value * 10 + digit;
-                        if (s < send) {
-                          digit = *++s - '0';
+                        if (++s < send) {
+                          digit = *s - '0';
                           if (digit >= 0 && digit <= 9) {
                             value = value * 10 + digit;
-                            if (s < send) {
-                              digit = *++s - '0';
+                            if (++s < send) {
+                              digit = *s - '0';
                               if (digit >= 0 && digit <= 9) {
                                 value = value * 10 + digit;
-                                if (s < send) {
-                                  digit = *++s - '0';
+                                if (++s < send) {
+                                  digit = *s - '0';
                                   if (digit >= 0 && digit <= 9) {
                                     value = value * 10 + digit;
-                                    if (s < send) {
+                                    if (++s < send) {
                                       /* Now got 9 digits, so need to check
                                          each time for overflow.  */
-                                      digit = *++s - '0';
+                                      digit = *s - '0';
                                       while (digit >= 0 && digit <= 9
                                              && (value < max_div_10
                                                  || (value == max_div_10
                                                      && digit <= max_mod_10))) {
                                         value = value * 10 + digit;
-                                        if (s < send)
-                                          digit = *++s - '0';
+                                        if (++s < send)
+                                          digit = *s - '0';
                                         else
                                           break;
                                       }

Thread Previous | Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About