This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
limit digits based on radix for oct/bin fp
authorTony Cook <tony@develop-help.com>
Tue, 5 Sep 2017 05:26:41 +0000 (15:26 +1000)
committerZefram <zefram@fysh.org>
Wed, 6 Dec 2017 01:56:30 +0000 (01:56 +0000)
All hexadecimal digits were being permitted in octal and binary floating
point literals.  (That octal and binary literals are permitted at all
might be an accidental result of permitting hexadecimal?)  Restrict which
digits are permitted, in accordance with the radix.

t/lib/croak/toke
t/op/hexfp.t
toke.c

index 082761e..1d45a3f 100644 (file)
@@ -462,3 +462,21 @@ tr//\N{}-0/;
 EXPECT
 Unknown charname '' at - line 1, within string
 Execution of - aborted due to compilation errors.
+########
+# NAME octal fp with non-octal digits after the decimal point
+01.1234567p0;
+07.8p0;
+EXPECT
+Bareword found where operator expected at - line 2, near "8p0"
+       (Missing operator before p0?)
+syntax error at - line 2, near "8p0"
+Execution of - aborted due to compilation errors.
+########
+# NAME binary fp with non-binary digits after the decimal point
+0b1.10p0;
+0b1.2p0;
+EXPECT
+Bareword found where operator expected at - line 2, near "2p0"
+       (Missing operator before p0?)
+syntax error at - line 2, near "2p0"
+Execution of - aborted due to compilation errors.
index e541cad..617c0fe 100644 (file)
@@ -10,7 +10,7 @@ use strict;
 
 use Config;
 
-plan(tests => 112);
+plan(tests => 123);
 
 # Test hexfloat literals.
 
@@ -265,6 +265,20 @@ SKIP: {
     is sprintf("%a", eval("0b110000000000000000000000000000000000000000000000000000000.1p0")), "0x1.8p+56";
 }
 
+# the implementation also allow for octal and binary fp
+is(01p0, 1);
+is(01.0p0, 1);
+is(01.00p0, 1);
+is(010.1p0, 8.125);
+is(00.400p1, 1);
+is(00p0, 0);
+is(01.1p0, 1.125);
+
+is(0b0p0, 0);
+is(0b1p0, 1);
+is(0b10p0, 2);
+is(0b1.1p0, 1.5);
+
 # 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 3baa520..60806a7 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -11078,9 +11078,11 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
                     NV nv_mult = 1.0;
 #endif
                     bool accumulate = TRUE;
-                    for (h++; (isXDIGIT(*h) || *h == '_'); h++) {
+                    U8 b;
+                    int lim = 1 << shift;
+                    for (h++; ((isXDIGIT(*h) && (b = XDIGIT_VALUE(*h)) < lim) ||
+                               *h == '_'); h++) {
                         if (isXDIGIT(*h)) {
-                            U8 b = XDIGIT_VALUE(*h);
                             significant_bits += shift;
 #ifdef HEXFP_UQUAD
                             if (accumulate) {