Skip Menu |
Report information
Id: 127474
Status: resolved
Priority: 0/
Queue: perl5

Owner: Nobody
Requestors: pipcet [at] gmail.com
Cc:
AdminCc:

Operating System: (no value)
PatchStatus: (no value)
Severity: low
Type: core
Perl Version: (no value)
Fixed In: (no value)



To: perlbug [...] perl.org
From: Pip Cet <pipcet [...] gmail.com>
Date: Sat, 6 Feb 2016 05:30:49 +0000
Subject: Perl_cast_uv broken with CASTFLAGS=7, no quad math, uvsize=4
Download (untitled) / with headers
text/plain 3.2k
This is a bug report for perl from pipcet@gmail.com,
generated with the help of perlbug 1.40 running under perl 5.22.1.


-----------------------------------------------------------------
[Please describe your issue here]

TL;DR: patch:

diff --git a/numeric.c b/numeric.c
index f1de219..f645502 100644
--- a/numeric.c
+++ b/numeric.c
@@ -39,7 +39,7 @@ Perl_cast_ulong(NV f)
     if (f < U32_MAX_P1_HALF)
       return (U32) f;
     f -= U32_MAX_P1_HALF;
-    return ((U32) f) | (1 + U32_MAX >> 1);
+    return ((U32) f) | (1 + (U32_MAX >> 1));
 #else
     return (U32) f;
 #endif
@@ -57,7 +57,7 @@ Perl_cast_i32(NV f)
     if (f < U32_MAX_P1_HALF)
       return (I32)(U32) f;
     f -= U32_MAX_P1_HALF;
-    return (I32)(((U32) f) | (1 + U32_MAX >> 1));
+    return (I32)(((U32) f) | (1 + (U32_MAX >> 1)));
 #else
     return (I32)(U32) f;
 #endif
@@ -76,7 +76,7 @@ Perl_cast_iv(NV f)
     if (f < UV_MAX_P1_HALF)
       return (IV)(UV) f;
     f -= UV_MAX_P1_HALF;
-    return (IV)(((UV) f) | (1 + UV_MAX >> 1));
+    return (IV)(((UV) f) | (1 + (UV_MAX >> 1)));
 #else
     return (IV)(UV) f;
 #endif
@@ -94,7 +94,7 @@ Perl_cast_uv(NV f)
     if (f < UV_MAX_P1_HALF)
       return (UV) f;
     f -= UV_MAX_P1_HALF;
-    return ((UV) f) | (1 + UV_MAX >> 1);
+    return ((UV) f) | (1 + (UV_MAX >> 1));
 #else
     return (UV) f;
 #endif

I am trying to build Perl 5 (git blead) using a somewhat unusual
virtual machine for which config.sh has decided in its infinite wisdom
castflags should be 7; I have decided quadmath should not be defined;
and the size of a UV is 4 bytes. This combination is running into
problems.

The symptom is that t/base/lex.t fails with the error message

    not ok 7 :443541004:

generated by this code

    eval '$foo = 123+123.4+123e4+123.4E5+123.4e+5+.12;';

    $foo = int($foo * 100 + .5);
    if ($foo eq 2591024652) {print "ok 7\n";} else {print "not ok 7 :$foo:\n";}

We're off by 1<<31! The culprit is in numeric.c's Perl_cast_uv, which
contains this line (enabled when CASTFLAGS & 2, as is the case here):

    return ((UV) f) | (1 + UV_MAX >> 1);

I think that should be

    return ((UV) f) | (1 + (UV_MAX >> 1));

which is equivalent on systems for which UV_MAX + 1 isn't 0 (assuming
UV_MAX is odd, at least...), but works on systems for which UV_MAX + 1
is 0.  The original line also causes compiler warnings along the lines
of:

    numeric.c:79:40: warning: suggest parentheses around ‘+’ inside ‘>>’ [-Wparentheses]
         return (IV)(((UV) f) | (1 + UV_MAX >> 1));

So even if I'm wrong, this code should probably be fixed another way
in order to avoid the warning to keep compile-time noise down.

(It's very suspicious that I'm using gcc but castflags has been set to
7, but I think we should err on the side of allowing castflags to be
set that needn't be).

Unfortunately, perlbug doesn't run yet on the virtual machine, so I'm
attaching config.sh instead of the build configuration for my system
Perl.

The GCC backend I'm using is experimental and not really ready for public discussion yet, but I'd be happy to share further details that are needed to fix this bug.

[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
    category=core
    severity=low
---

Download perl-002.diff
text/plain 1k

Message body is not shown because sender requested not to inline it.

Download config.sh
application/x-sh 27.8k

Message body not shown because it is not plain text.

RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 1.2k
On Fri Feb 05 21:31:07 2016, pipcet@gmail.com wrote: Show quoted text
> TL;DR: patch: > > diff --git a/numeric.c b/numeric.c > index f1de219..f645502 100644 > --- a/numeric.c > +++ b/numeric.c
... Show quoted text
> > I am trying to build Perl 5 (git blead) using a somewhat unusual > virtual machine for which config.sh has decided in its infinite wisdom > castflags should be 7; I have decided quadmath should not be defined; > and the size of a UV is 4 bytes. This combination is running into > problems. > > The symptom is that t/base/lex.t fails with the error message > > not ok 7 :443541004: > > generated by this code > > eval '$foo = 123+123.4+123e4+123.4E5+123.4e+5+.12;'; > > $foo = int($foo * 100 + .5); > if ($foo eq 2591024652) {print "ok 7\n";} else {print "not ok 7 > :$foo:\n";} > > We're off by 1<<31! The culprit is in numeric.c's Perl_cast_uv, which > contains this line (enabled when CASTFLAGS & 2, as is the case here):
I didn't get the exact failures you did by manually setting castflags to 7, but I did get failures, and I did see the same warnings. Your changes fixed both the compiler warnings and the test failures. Applied your changes as 071db91b12fc08b6b110d18071c50fbe490129ce and added you to AUTHORS in 966178a1f62804c2ffcbd4cb0d2e9a28a118ea1c. Tony
Download (untitled) / with headers
text/plain 252b
Thank you for submitting this report. You have helped make Perl better. With the release of Perl 5.24.0 on May 9, 2016, this and 149 other issues have been resolved. Perl 5.24.0 may be downloaded via https://metacpan.org/release/RJBS/perl-5.24.0


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

For issues related to this RT instance (aka "perlbug"), please contact perlbug-admin at perl.org