Fix overloading for binary and octal floats

perl-5.30.1-perl-125557-correctly-handle-overload-for-bin-oct-fl.patch

@@ -0,0 +1,116 @@
+From b061e315b4eac4d82edb3ca14581805417a68936 Mon Sep 17 00:00:00 2001
+From: Tony Cook <tony@develop-help.com>
+Date: Wed, 11 Sep 2019 11:50:23 +1000
+Subject: [PATCH] (perl #125557) correctly handle overload for bin/oct floats
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+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.
+
+Petr Písař: Ported to 5.30.1 from
+2cb5a7e8af11acb0eca22421ec5a4df7ef18e2a9.
+
+Signed-off-by: Petr Písař <ppisar@redhat.com>
+---
+ 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 64f8136..0f239d4 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 03c4f2b..3fa20dc 100644
+--- a/toke.c
++++ b/toke.c
+@@ -10966,6 +10966,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) { \
+@@ -11012,8 +11013,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
+@@ -11022,7 +11021,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? */
+ 	    static const NV nvshift[5] = { 1.0, 2.0, 4.0, 8.0, 16.0 };
+@@ -11369,8 +11367,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 */
+-- 
+2.21.0
+

perl.spec

@@ -85,7 +85,7 @@ License:        GPL+ or Artistic
 Epoch:          %{perl_epoch}
 Version:        %{perl_version}
 # release number must be even higher, because dual-lived modules will be broken otherwise
-Release:        447%{?dist}
+Release:        448%{?dist}
 Summary:        Practical Extraction and Report Language
 Url:            https://www.perl.org/
 Source0:        https://www.cpan.org/src/5.0/perl-%{perl_version}.tar.xz
@@ -260,6 +260,10 @@ Patch59:        perl-5.31.3-Supply-missing-right-brace-in-regex-example.patch
 Patch61:        perl-5.31.3-Configure-Include-stdlib.h-in-futimes-check.patch
 Patch62:        perl-5.31.3-Florian-Weimer-is-now-a-perl-author.patch
 
+# Fix overloading for binary and octal floats, RT#125557,
+# in upstream after 5.31.3
+Patch63:        perl-5.30.1-perl-125557-correctly-handle-overload-for-bin-oct-fl.patch
+
 # Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048
 Patch200:       perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch
 
@@ -2843,6 +2847,7 @@ rm -rf .git # Perl tests examine a git repository
 %patch59 -p1
 %patch61 -p1
 %patch62 -p1
+%patch63 -p1
 %patch200 -p1
 %patch201 -p1
 
@@ -2900,6 +2905,7 @@ perl -x patchlevel.h \
     'Fedora Patch59: Correct a misspelling in perlrebackslash documentation (RT#134395)' \
     'Fedora Patch61: Fix a detection for futimes (RT#134432)' \
     'Fedora Patch62: Fix a detection for futimes (RT#134432)' \
+    'Fedora Patch63: Fix overloading for binary and octal floats (RT#125557)' \
     'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \
     'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
     %{nil}
@@ -5145,6 +5151,9 @@ popd
 
 # Old changelog entries are preserved in CVS.
 %changelog
+* Tue Nov 12 2019 Petr Pisar <ppisar@redhat.com> - 4:5.30.1-448
+- Fix overloading for binary and octal floats (RT#125557)
+
 * Mon Nov 11 2019 Jitka Plesnikova <jplesnik@redhat.com> - 4:5.30.1-447
 - 5.30.1 bump (see <https://metacpan.org/pod/release/SHAY/perl-5.30.1/pod/perldelta.pod>
   for release notes)