Fix overloading for binary and octal floats
This commit is contained in:
parent
547455e52c
commit
5d3b4b53fc
|
@ -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
|
||||||
|
|
11
perl.spec
11
perl.spec
|
@ -85,7 +85,7 @@ License: GPL+ or Artistic
|
||||||
Epoch: %{perl_epoch}
|
Epoch: %{perl_epoch}
|
||||||
Version: %{perl_version}
|
Version: %{perl_version}
|
||||||
# release number must be even higher, because dual-lived modules will be broken otherwise
|
# 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
|
Summary: Practical Extraction and Report Language
|
||||||
Url: https://www.perl.org/
|
Url: https://www.perl.org/
|
||||||
Source0: https://www.cpan.org/src/5.0/perl-%{perl_version}.tar.xz
|
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
|
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
|
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
|
# 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
|
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
|
%patch59 -p1
|
||||||
%patch61 -p1
|
%patch61 -p1
|
||||||
%patch62 -p1
|
%patch62 -p1
|
||||||
|
%patch63 -p1
|
||||||
%patch200 -p1
|
%patch200 -p1
|
||||||
%patch201 -p1
|
%patch201 -p1
|
||||||
|
|
||||||
|
@ -2900,6 +2905,7 @@ perl -x patchlevel.h \
|
||||||
'Fedora Patch59: Correct a misspelling in perlrebackslash documentation (RT#134395)' \
|
'Fedora Patch59: Correct a misspelling in perlrebackslash documentation (RT#134395)' \
|
||||||
'Fedora Patch61: Fix a detection for futimes (RT#134432)' \
|
'Fedora Patch61: Fix a detection for futimes (RT#134432)' \
|
||||||
'Fedora Patch62: 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 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' \
|
'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
|
||||||
%{nil}
|
%{nil}
|
||||||
|
@ -5145,6 +5151,9 @@ popd
|
||||||
|
|
||||||
# Old changelog entries are preserved in CVS.
|
# Old changelog entries are preserved in CVS.
|
||||||
%changelog
|
%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
|
* 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>
|
- 5.30.1 bump (see <https://metacpan.org/pod/release/SHAY/perl-5.30.1/pod/perldelta.pod>
|
||||||
for release notes)
|
for release notes)
|
||||||
|
|
Loading…
Reference in New Issue