Don't assume that we can chmod symlinks. It fails on MacOSX HFS+ when building using...
[p5sagit/p5-mst-13.2.git] / numeric.c
index c71d5b3..913ecc8 100644 (file)
--- a/numeric.c
+++ b/numeric.c
@@ -1,6 +1,6 @@
 /*    numeric.c
  *
- *    Copyright (c) 2001, Larry Wall
+ *    Copyright (c) 2001-2002, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
  * wizards count differently to other people."
  */
 
+/*
+=head1 Numeric functions
+*/
+
 #include "EXTERN.h"
 #define PERL_IN_NUMERIC_C
 #include "perl.h"
@@ -122,8 +126,9 @@ returns UV_MAX, sets C<PERL_SCAN_GREATER_THAN_UV_MAX> in the output flags,
 and writes the value to I<*result> (or the value is discarded if I<result>
 is NULL).
 
-The hex number may optinally be prefixed with "0b" or "b". If
-C<PERL_SCAN_ALLOW_UNDERSCORES> is set in I<*flags> on entry then the binary
+The hex number may optionally be prefixed with "0b" or "b" unless
+C<PERL_SCAN_DISALLOW_PREFIX> is set in I<*flags> on entry. If
+C<PERL_SCAN_ALLOW_UNDERSCORES> is set in I<*flags> then the binary
 number may use '_' characters to separate digits.
 
 =cut
@@ -140,18 +145,20 @@ Perl_grok_bin(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) {
     bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
     bool overflowed = FALSE;
 
-    /* strip off leading b or 0b.
-       for compatibility silently suffer "b" and "0b" as valid binary numbers.
-    */
-    if (len >= 1) {
-       if (s[0] == 'b') {
-           s++;
-           len--;
-       }
-       else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
-           s+=2;
-           len-=2;
-       }
+    if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
+        /* strip off leading b or 0b.
+           for compatibility silently suffer "b" and "0b" as valid binary
+           numbers. */
+        if (len >= 1) {
+            if (s[0] == 'b') {
+                s++;
+                len--;
+            }
+            else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
+                s+=2;
+                len-=2;
+            }
+        }
     }
 
     for (; len-- && *s; s++) {
@@ -175,7 +182,7 @@ Perl_grok_bin(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) {
             }
             value_nv *= 2.0;
            /* If an NV has not enough bits in its mantissa to
-            * represent an UV this summing of small low-order numbers
+            * represent a 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 value_nv by the
@@ -233,8 +240,9 @@ returns UV_MAX, sets C<PERL_SCAN_GREATER_THAN_UV_MAX> in the output flags,
 and writes the value to I<*result> (or the value is discarded if I<result>
 is NULL).
 
-The hex number may optinally be prefixed with "0x" or "x". If
-C<PERL_SCAN_ALLOW_UNDERSCORES> is set in I<*flags> on entry then the hex
+The hex number may optionally be prefixed with "0x" or "x" unless
+C<PERL_SCAN_DISALLOW_PREFIX> is set in I<*flags> on entry. If
+C<PERL_SCAN_ALLOW_UNDERSCORES> is set in I<*flags> then the hex
 number may use '_' characters to separate digits.
 
 =cut
@@ -252,17 +260,20 @@ Perl_grok_hex(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) {
     bool overflowed = FALSE;
     const char *hexdigit;
 
-    /* strip off leading x or 0x.
-       for compatibility silently suffer "x" and "0x" as valid hex numbers.  */
-    if (len >= 1) {
-       if (s[0] == 'x') {
-           s++;
-           len--;
-       }
-       else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
-           s+=2;
-           len-=2;
-       }
+    if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
+        /* strip off leading x or 0x.
+           for compatibility silently suffer "x" and "0x" as valid hex numbers.
+        */
+        if (len >= 1) {
+            if (s[0] == 'x') {
+                s++;
+                len--;
+            }
+            else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
+                s+=2;
+                len-=2;
+            }
+        }
     }
 
     for (; len-- && *s; s++) {
@@ -286,7 +297,7 @@ Perl_grok_hex(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) {
             }
             value_nv *= 16.0;
            /* If an NV has not enough bits in its mantissa to
-            * represent an UV this summing of small low-order numbers
+            * represent a 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 value_nv by the
@@ -368,7 +379,7 @@ Perl_grok_oct(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) {
             }
             value_nv *= 8.0;
            /* If an NV has not enough bits in its mantissa to
-            * represent an UV this summing of small low-order numbers
+            * represent a 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 value_nv by the