This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
(perl #125557) correctly handle overload for bin/oct floats
authorTony Cook <tony@develop-help.com>
Wed, 11 Sep 2019 01:50:23 +0000 (11:50 +1000)
committerTony Cook <tony@develop-help.com>
Mon, 16 Sep 2019 00:17:31 +0000 (10:17 +1000)
The hexfp code doesn't check that the shift is 4, and so also
accepts binary and octal fp numbers.

Unfortunately the call to S_new_constant() always passed a prefix
of 0x, so overloading would be trying to parse the wrong number.

Another option is to simply allow only hex floats, though some work
was done in 131894 to improve oct/bin float support.

t/op/hexfp.t
toke.c

index eeb2c9d..b0c85cf 100644 (file)
@@ -10,7 +10,7 @@ use strict;
 
 use Config;
 
-plan(tests => 123);
+plan(tests => 125);
 
 # Test hexfloat literals.
 
@@ -277,6 +277,20 @@ is(0b1p0, 1);
 is(0b10p0, 2);
 is(0b1.1p0, 1.5);
 
+# previously these would pass "0x..." to the overload instead of the appropriate
+# "0b" or "0" prefix.
+fresh_perl_is(<<'CODE', "1", {}, "overload binary fp");
+use overload;
+BEGIN { overload::constant float => sub { return eval $_[0]; }; }
+print 0b0.1p1;
+CODE
+
+fresh_perl_is(<<'CODE', "1", {}, "overload octal fp");
+use overload;
+BEGIN { overload::constant float => sub { return eval $_[0]; }; }
+print 00.1p3;
+CODE
+
 # sprintf %a/%A testing is done in sprintf2.t,
 # trickier than necessary because of long doubles,
 # and because looseness of the spec.
diff --git a/toke.c b/toke.c
index 26de580..4624107 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -10968,6 +10968,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
     const char *lastub = NULL;         /* position of last underbar */
     static const char* const number_too_long = "Number too long";
     bool warned_about_underscore = 0;
+    I32 shift; /* shift per digit for hex/oct/bin, hoisted here for fp */
 #define WARN_ABOUT_UNDERSCORE() \
        do { \
            if (!warned_about_underscore) { \
@@ -11014,8 +11015,6 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
        {
          /* variables:
             u          holds the "number so far"
-            shift      the power of 2 of the base
-                       (hex == 4, octal == 3, binary == 1)
             overflowed was the number more than we can hold?
 
             Shift is used when we add a digit.  It also serves as an "are
@@ -11024,7 +11023,6 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
           */
            NV n = 0.0;
            UV u = 0;
-           I32 shift;
            bool overflowed = FALSE;
            bool just_zero  = TRUE;     /* just plain 0 or binary number? */
             bool has_digs = FALSE;
@@ -11388,8 +11386,21 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
         if (hexfp) {
             floatit = TRUE;
             *d++ = '0';
-            *d++ = 'x';
-            s = start + 2;
+            switch (shift) {
+            case 4:
+                *d++ = 'x';
+                s = start + 2;
+                break;
+            case 3:
+                s = start + 1;
+                break;
+            case 1:
+                *d++ = 'b';
+                s = start + 2;
+                break;
+            default:
+                NOT_REACHED; /* NOTREACHED */
+            }
         }
 
        /* read next group of digits and _ and copy into d */