add hexfloat support to constant overloads

[p5pRT]

Migrated from rt.perl.org#125557 (status was 'pending release')

Searchable as RT125557$

[p5pRT]

From @rjbs

Created by @rjbs

Saašha Metsärantala reports, as far as I can tell correctly, that you cannot
use overload.pm's constant overloading feature to overload hex float literals.

This would probably be nice to have someday for someone.

Perl Info

Flags:
    category=library
    severity=wishlist
    module=overload

Site configuration information for perl 5.18.1:

Configured by rjbs at Fri Nov 15 18:17:55 EST 2013.

Summary of my perl5 (revision 5 version 18 subversion 1) configuration:
   
  Platform:
    osname=linux, osvers=3.7.10-linode49, archname=i686-linux
    uname='linux cancer 3.7.10-linode49 #2 smp wed feb 27 14:15:25 est 2013 i686 gnulinux '
    config_args='-Dprefix=/home/rjbs/.plenv/versions/18.1 -de -Dusedevel -A'eval:scriptdir=/home/rjbs/.plenv/versions/18.1/bin''
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=undef, usemultiplicity=undef
    useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
    use64bitint=undef, use64bitall=undef, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O2',
    cppflags='-fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include'
    ccversion='', gccversion='4.8.2', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=4, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -fstack-protector -L/usr/local/lib -L/opt/local/lib'
    libpth=/usr/local/lib /opt/local/lib /lib/i386-linux-gnu /lib/../lib /usr/lib/i386-linux-gnu /usr/lib/../lib /lib /usr/lib
    libs=-lnsl -ldl -lm -lcrypt -lutil -lc
    perllibs=-lnsl -ldl -lm -lcrypt -lutil -lc
    libc=, so=so, useshrplib=false, libperl=libperl.a
    gnulibc_version='2.17'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
    cccdlflags='-fPIC', lddlflags='-shared -O2 -L/usr/local/lib -L/opt/local/lib -fstack-protector'

Locally applied patches:
    


@INC for perl 5.18.1:
    /home/rjbs/.plenv/versions/18.1/lib/perl5/site_perl/5.18.1/i686-linux
    /home/rjbs/.plenv/versions/18.1/lib/perl5/site_perl/5.18.1
    /home/rjbs/.plenv/versions/18.1/lib/perl5/5.18.1/i686-linux
    /home/rjbs/.plenv/versions/18.1/lib/perl5/5.18.1
    .


Environment for perl 5.18.1:
    HOME=/home/rjbs
    LANG=en_US.UTF-8
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/home/rjbs/.plenv/versions/18.1/bin:/home/rjbs/.plenv/libexec:/home/rjbs/.plenv/plugins/perl-build/bin:/home/rjbs/bin:/home/rjbs/.plenv/shims:/home/rjbs/.plenv/bin:/usr/bin:/bin:/usr/sbin:/sbin:/usr/local/bin:/opt/X11/bin
    PERLDOC=-otext
    PERL_AUTOINSTALL=--skipdeps
    PERL_BADLANG (unset)
    PERL_MAILERS=sendmail:/usr/sbin/sendmail
    SHELL=/bin/zsh

[p5pRT]

From @tonycoz

On Sun Jul 05 18​:56​:18 2015, rjbs wrote​:

Saašha Metsärantala reports, as far as I can tell correctly, that you
cannot
use overload.pm's constant overloading feature to overload hex float
literals.

This would probably be nice to have someday for someone.

Currently each type of constant overload uses a hints bit​:

#define HINT_NEW_INTEGER 0x00001000
#define HINT_NEW_FLOAT 0x00002000
#define HINT_NEW_BINARY 0x00004000
#define HINT_NEW_STRING 0x00008000
#define HINT_NEW_RE 0x00010000

which we're kind of short on.

Maybe instead of allocating a bit to each type of overloading we should only use
a single bit to indicate there *some* sort of constant overloading happening,
and toke.c then checks $^H{whichever} to decide if that particular type of
constant should be overloaded.

This would slow down compiling code that uses any overloaded constant type, but
I'd expect that to be fairly rare (maybe I'm wrong), and would free up 4 bits in
PL_hints for other uses.

Or maybe it's time for PL_hints2/${^H2}.

Tony

[p5pRT]

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

[p5pRT]

From @khwilliamson

On 08/05/2015 12​:30 AM, Tony Cook via RT wrote​:

On Sun Jul 05 18​:56​:18 2015, rjbs wrote​:

Saašha Metsärantala reports, as far as I can tell correctly, that you
cannot
use overload.pm's constant overloading feature to overload hex float
literals.

This would probably be nice to have someday for someone.

Currently each type of constant overload uses a hints bit​:

#define HINT_NEW_INTEGER 0x00001000
#define HINT_NEW_FLOAT 0x00002000
#define HINT_NEW_BINARY 0x00004000
#define HINT_NEW_STRING 0x00008000
#define HINT_NEW_RE 0x00010000

which we're kind of short on.

Maybe instead of allocating a bit to each type of overloading we should only use
a single bit to indicate there *some* sort of constant overloading happening,
and toke.c then checks $^H{whichever} to decide if that particular type of
constant should be overloaded.

This would slow down compiling code that uses any overloaded constant type, but
I'd expect that to be fairly rare (maybe I'm wrong), and would free up 4 bits in
PL_hints for other uses.

As the comments in the code say, the 2 locale bits could be combined to
save one bit. Those are looked at at runtime.

Concerning the constant overloading bits​: Since these are compile-only,
slowing down compilation by the minuscule amount this would cost
shouldn't be a problem. So this seems to me to be the way to go.

Or maybe it's time for PL_hints2/${^H2}.

Tony

---
via perlbug​: queue​: perl5 status​: new
https://rt-archive.perl.org/perl5/Ticket/Display.html?id=125557

[p5pRT]

From @rjbs

* Tony Cook via RT <perlbug-followup@​perl.org> [2015-08-05T02​:30​:07]

Maybe instead of allocating a bit to each type of overloading we should only
use a single bit to indicate there *some* sort of constant overloading
happening, and toke.c then checks $^H{whichever} to decide if that particular
type of constant should be overloaded.

This would slow down compiling code that uses any overloaded constant type,
but I'd expect that to be fairly rare (maybe I'm wrong), and would free up 4
bits in PL_hints for other uses.

I also guess this is quite rare. That's a guess, mind you. I would further
guess that the largest that constant overloading gets into programs is bignum
and brethren, for whatever that is worth.

I don't really have an opinion on how to proceed, but lean toward agreement
with Karl.

--
rjbs

[p5pRT]

From @tonycoz

On Wed, 05 Aug 2015 12​:37​:58 -0700, perl.p5p@​rjbs.manxome.org wrote​:

* Tony Cook via RT <perlbug-followup@​perl.org> [2015-08-05T02​:30​:07]

Maybe instead of allocating a bit to each type of overloading we
should only
use a single bit to indicate there *some* sort of constant
overloading
happening, and toke.c then checks $^H{whichever} to decide if that
particular
type of constant should be overloaded.

This would slow down compiling code that uses any overloaded constant
type,
but I'd expect that to be fairly rare (maybe I'm wrong), and would
free up 4
bits in PL_hints for other uses.

I also guess this is quite rare. That's a guess, mind you. I would
further
guess that the largest that constant overloading gets into programs is
bignum
and brethren, for whatever that is worth.

I don't really have an opinion on how to proceed, but lean toward
agreement
with Karl.

It turns out this old bug isn't really an issue​:

tony@​mars​:.../git/perl$ cat biggish.pm
package biggish;
use overload;

sub import {
  overload​::constant float => sub {
  my ($str, $type, $usage) = @​_;
  print STDERR "Called​: @​_\n";
  return eval $str;
  };
}

1;
tony@​mars​:.../git/perl$ ./perl -Ilib -I. -Mbiggish -wle 'print 0x0.1p1'
Use of uninitialized value in join or string at biggish.pm line 7.
Called​: 0x0.1p1 0.125

0.125

The usual float handler is called even for hex floating point constants.

Tony

[p5pRT]

From @pjacklam

This is indeed an issue with binary float constants​:

$ perl -Ilib -I. -Mbiggish -wle 'print 0b0.1p1'
Use of uninitialized value in join or string at biggish.pm line 7.
Called​: 0x0.1p1 1

0.125

This should return 1, not 0.125.

Apparently, binary floating point constants are handled as if they
were hex floating points constants. This is a bug. When a binary
floating point constant is used, perl should either give the correct
value or a warning/error.

Peter

[p5pRT]

From @tonycoz

On Tue, 10 Sep 2019 02​:34​:12 -0700, pjacklam@​gmail.com wrote​:

This is indeed an issue with binary float constants​:

$ perl -Ilib -I. -Mbiggish -wle 'print 0b0.1p1'
Use of uninitialized value in join or string at biggish.pm line 7.
Called​: 0x0.1p1 1

0.125

This should return 1, not 0.125.

Apparently, binary floating point constants are handled as if they
were hex floating points constants. This is a bug. When a binary
floating point constant is used, perl should either give the correct
value or a warning/error.

How about the attached?

Tony

[p5pRT]

From @tonycoz

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

From ccd8684d61be4cc68d7a945ce24b981c8de447fa Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 11 Sep 2019 11:50:23 +1000
Subject: (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.
---
 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 */
-- 
2.11.0

[p5pRT]

From @pjacklam

Tony,

I have tested the patch, and it looks good. Thanks for fixing this issue!

Peter

[p5pRT]

From @tonycoz

On Sat, 14 Sep 2019 04​:33​:23 -0700, pjacklam@​gmail.com wrote​:

Tony,

I have tested the patch, and it looks good. Thanks for fixing this issue!

Thanks for the feedback, applied as 2cb5a7e.

Tony

[p5pRT]

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