develooper Front page | perl.perl5.changes | Postings from September 2019

[perl.git] branch blead updated. v5.31.3-186-g2cb5a7e8af

From:
Tony Cook
Date:
September 16, 2019 00:45
Subject:
[perl.git] branch blead updated. v5.31.3-186-g2cb5a7e8af
Message ID:
E1i9f8M-0000WK-6U@git.dc.perl.space
In perl.git, the branch blead has been updated

<https://perl5.git.perl.org/perl.git/commitdiff/2cb5a7e8af11acb0eca22421ec5a4df7ef18e2a9?hp=3ace85ea4f1777b7a1f1151aef632e45926bbbae>

- Log -----------------------------------------------------------------
commit 2cb5a7e8af11acb0eca22421ec5a4df7ef18e2a9
Author: Tony Cook <tony@develop-help.com>
Date:   Wed Sep 11 11:50:23 2019 +1000

    (perl #125557) correctly handle overload for bin/oct floats
    
    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.

-----------------------------------------------------------------------

Summary of changes:
 t/op/hexfp.t | 16 +++++++++++++++-
 toke.c       | 21 ++++++++++++++++-----
 2 files changed, 31 insertions(+), 6 deletions(-)

diff --git a/t/op/hexfp.t b/t/op/hexfp.t
index eeb2c9d364..b0c85cfdc6 100644
--- a/t/op/hexfp.t
+++ b/t/op/hexfp.t
@@ -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 26de580a24..4624107c45 100644
--- 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 */

-- 
Perl5 Master Repository



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