In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/a674e8db187f4e33b2e6b9341cc0e30fbcf75bd2?hp=8d4088782934a96fb4c8a4688f9c24f45ea353fa>
- Log ----------------------------------------------------------------- commit a674e8db187f4e33b2e6b9341cc0e30fbcf75bd2 Author: Bo Lindbergh <[email protected]> Date: Mon Jul 5 01:31:01 2010 +0200 Code for allowing uppercase X/B in hexadecimal/binary numbers (#76296). Signed-off-by: David Golden <[email protected]> M numeric.c M pp.c M toke.c commit 333f87f24de2f15740185612410ef911ccfed6a3 Author: Bo Lindbergh <[email protected]> Date: Mon Jul 5 00:04:46 2010 +0200 Tests for allowing uppercase X/B in hexadecimal/binary numbers (#76296). Signed-off-by: David Golden <[email protected]> M t/base/num.t M t/op/oct.t ----------------------------------------------------------------------- Summary of changes: numeric.c | 8 ++++---- pp.c | 4 ++-- t/base/num.t | 15 ++++++++++++++- t/op/oct.t | 15 ++++++++++++--- toke.c | 4 ++-- 5 files changed, 34 insertions(+), 12 deletions(-) diff --git a/numeric.c b/numeric.c index b116376..e7e740f 100644 --- a/numeric.c +++ b/numeric.c @@ -153,11 +153,11 @@ Perl_grok_bin(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) for compatibility silently suffer "b" and "0b" as valid binary numbers. */ if (len >= 1) { - if (s[0] == 'b') { + if (s[0] == 'b' || s[0] == 'B') { s++; len--; } - else if (len >= 2 && s[0] == '0' && s[1] == 'b') { + else if (len >= 2 && s[0] == '0' && (s[1] == 'b' || s[1] == 'B')) { s+=2; len-=2; } @@ -269,11 +269,11 @@ Perl_grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) for compatibility silently suffer "x" and "0x" as valid hex numbers. */ if (len >= 1) { - if (s[0] == 'x') { + if (s[0] == 'x' || s[0] == 'X') { s++; len--; } - else if (len >= 2 && s[0] == '0' && s[1] == 'x') { + else if (len >= 2 && s[0] == '0' && (s[1] == 'x' || s[1] == 'X')) { s+=2; len-=2; } diff --git a/pp.c b/pp.c index a596ad3..64facc2 100644 --- a/pp.c +++ b/pp.c @@ -3067,11 +3067,11 @@ PP(pp_oct) tmps++, len--; if (*tmps == '0') tmps++, len--; - if (*tmps == 'x') { + if (*tmps == 'x' || *tmps == 'X') { hex: result_uv = grok_hex (tmps, &len, &flags, &result_nv); } - else if (*tmps == 'b') + else if (*tmps == 'b' || *tmps == 'B') result_uv = grok_bin (tmps, &len, &flags, &result_nv); else result_uv = grok_oct (tmps, &len, &flags, &result_nv); diff --git a/t/base/num.t b/t/base/num.t index 06eea52..fbeddc9 100644 --- a/t/base/num.t +++ b/t/base/num.t @@ -1,6 +1,6 @@ #!./perl -print "1..50\n"; +print "1..53\n"; # First test whether the number stringification works okay. # (Testing with == would exercize the IV/NV part, not the PV.) @@ -50,6 +50,8 @@ print $a eq "256" ? "ok 14\n" : "not ok 14 # $a\n"; $a = 1000; "$a"; print $a eq "1000" ? "ok 15\n" : "not ok 15 # $a\n"; +# more hex and binary tests below starting at 51 + # Okay, now test the numerics. # We may be assuming too much, given the painfully well-known floating # point sloppiness, but the following are still quite reasonable @@ -196,3 +198,14 @@ print $a == 10.0 ? "ok 49\n" : "not ok 49\n"; $a = 57.295779513082320876798154814169; print ok($a*10,572.95779513082320876798154814169,1e-10) ? "ok 50\n" : "not ok 50 # $a\n"; + +# Allow uppercase base markers (#76296) + +$a = 0Xabcdef; "$a"; +print $a eq "11259375" ? "ok 51\n" : "not ok 51 # $a\n"; + +$a = 0XFEDCBA; "$a"; +print $a eq "16702650" ? "ok 52\n" : "not ok 52 # $a\n"; + +$a = 0B1101; "$a"; +print $a eq "13" ? "ok 53\n" : "not ok 53 # $a\n"; diff --git a/t/op/oct.t b/t/op/oct.t index f996b48..dcd2256 100644 --- a/t/op/oct.t +++ b/t/op/oct.t @@ -2,7 +2,7 @@ # tests 51 onwards aren't all warnings clean. (intentionally) -print "1..71\n"; +print "1..77\n"; my $test = 1; @@ -25,10 +25,10 @@ sub test ($$$) { print "ok $test # $act $string\n"; } else { my ($valstr, $resstr); - if ($act eq 'hex' or $string =~ /x/) { + if ($act eq 'hex' or $string =~ /x/i) { $valstr = sprintf "0x%X", $value; $resstr = sprintf "0x%X", $result; - } elsif ($string =~ /b/) { + } elsif ($string =~ /b/i) { $valstr = sprintf "0b%b", $value; $resstr = sprintf "0b%b", $result; } else { @@ -150,3 +150,12 @@ print $@ =~ /Wide character/ ? "ok $test\n" : "not ok $test\n"; $test++; eval '$a = hex "ab\x{100}"'; print $@ =~ /Wide character/ ? "ok $test\n" : "not ok $test\n"; $test++; + +# Allow uppercase base markers (#76296) + +test ('hex', "0XCAFE", 0xCAFE); +test ('hex', "XCAFE", 0xCAFE); +test ('oct', "0XCAFE", 0xCAFE); +test ('oct', "XCAFE", 0xCAFE); +test ('oct', "0B101001", 0b101001); +test ('oct', "B101001", 0b101001); diff --git a/toke.c b/toke.c index 0decca8..b7b33e8 100644 --- a/toke.c +++ b/toke.c @@ -12978,11 +12978,11 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) const char *base, *Base, *max; /* check for hex */ - if (s[1] == 'x') { + if (s[1] == 'x' || s[1] == 'X') { shift = 4; s += 2; just_zero = FALSE; - } else if (s[1] == 'b') { + } else if (s[1] == 'b' || s[1] == 'B') { shift = 1; s += 2; just_zero = FALSE; -- Perl5 Master Repository
