Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Perl_cast_uv broken with CASTFLAGS=7, no quad math, uvsize=4 #15162

Closed
p5pRT opened this issue Feb 6, 2016 · 8 comments
Closed

Perl_cast_uv broken with CASTFLAGS=7, no quad math, uvsize=4 #15162

p5pRT opened this issue Feb 6, 2016 · 8 comments

Comments

@p5pRT
Copy link

p5pRT commented Feb 6, 2016

Migrated from rt.perl.org#127474 (status was 'resolved')

Searchable as RT127474$

@p5pRT
Copy link
Author

p5pRT commented Feb 6, 2016

From pipcet@gmail.com

Created by pipcet@gmail.com

TL;DR​: patch​:

Inline 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.

Perl Info

Flags:
    category=core
    severity=low


@p5pRT
Copy link
Author

p5pRT commented Feb 6, 2016

From pipcet@gmail.com

perl-002.diff
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

@p5pRT
Copy link
Author

p5pRT commented Feb 6, 2016

From pipcet@gmail.com

config.sh

@p5pRT
Copy link
Author

p5pRT commented Feb 7, 2016

From @tonycoz

On Fri Feb 05 21​:31​:07 2016, pipcet@​gmail.com wrote​:

TL;DR​: patch​:

diff --git a/numeric.c b/numeric.c
index f1de219..f645502 100644
--- a/numeric.c
+++ b/numeric.c
...

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&#8203;:

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 071db91 and added you to AUTHORS in 966178a.

Tony

@p5pRT
Copy link
Author

p5pRT commented Feb 7, 2016

The RT System itself - Status changed from 'new' to 'open'

@p5pRT
Copy link
Author

p5pRT commented Feb 7, 2016

@tonycoz - Status changed from 'open' to 'pending release'

@p5pRT
Copy link
Author

p5pRT commented May 13, 2016

From @khwilliamson

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

@p5pRT p5pRT closed this as completed May 13, 2016
@p5pRT
Copy link
Author

p5pRT commented May 13, 2016

@khwilliamson - Status changed from 'pending release' to 'resolved'

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

1 participant