In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/059639d5cdd8e4ce8732e497e1c8a0d9deafc7b3?hp=d8fe30adb48694ba33b463f653894093f743a8f0>
- Log ----------------------------------------------------------------- commit 059639d5cdd8e4ce8732e497e1c8a0d9deafc7b3 Author: Tony Cook <[email protected]> Date: Tue Jul 23 09:18:41 2013 +1000 [perl #74798] improved useqq compatibility with the pure perl version Currently for non-useqq, the pure perl and XS output for numbers like these is different, but XS useqq is new, so try to remain vaguely compatible. ----------------------------------------------------------------------- Summary of changes: dist/Data-Dumper/Dumper.xs | 45 +++++++++++++++++++++++++++++++++++++++++++++ dist/Data-Dumper/t/dumper.t | 21 +++++++++++++++++++-- 2 files changed, 64 insertions(+), 2 deletions(-) diff --git a/dist/Data-Dumper/Dumper.xs b/dist/Data-Dumper/Dumper.xs index 0194a2c..99424c5 100644 --- a/dist/Data-Dumper/Dumper.xs +++ b/dist/Data-Dumper/Dumper.xs @@ -119,6 +119,42 @@ TOP: return 0; } +/* Check that the SV can be represented as a simple decimal integer. + * + * The perl code does this by matching against /^(?:0|-?[1-9]\d{0,8})\z/ +*/ +static bool +safe_decimal_number(SV *val) { + STRLEN len; + const char *p = SvPV(val, len); + + if (len == 1 && *p == '0') + return TRUE; + + if (len && *p == '-') { + ++p; + --len; + } + + if (len == 0 || *p < '1' || *p > '9') + return FALSE; + + ++p; + --len; + + if (len > 8) + return FALSE; + + while (len > 0) { + /* the perl code checks /\d/ but we don't want unicode digits here */ + if (*p < '0' || *p > '9') + return FALSE; + ++p; + --len; + } + return TRUE; +} + /* count the number of "'"s and "\"s in string */ static I32 num_q(const char *s, STRLEN slen) @@ -1115,6 +1151,15 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv, sv_catpvn(retval, (const char *)mg->mg_ptr, mg->mg_len); } #endif + + /* the pure perl and XS non-qq outputs have historically been + * different in this case, but for useqq, let's try to match + * the pure perl code. + * see [perl #74798] + */ + else if (useqq && safe_decimal_number(val)) { + sv_catsv(retval, val); + } else { integer_came_from_string: c = SvPV(val, i); diff --git a/dist/Data-Dumper/t/dumper.t b/dist/Data-Dumper/t/dumper.t index 0a3c28c..dbc6d5e 100644 --- a/dist/Data-Dumper/t/dumper.t +++ b/dist/Data-Dumper/t/dumper.t @@ -83,11 +83,11 @@ sub SKIP_TEST { $Data::Dumper::Useperl = 1; if (defined &Data::Dumper::Dumpxs) { print "### XS extension loaded, will run XS tests\n"; - $TMAX = 420; $XS = 1; + $TMAX = 426; $XS = 1; } else { print "### XS extensions not loaded, will NOT run XS tests\n"; - $TMAX = 210; $XS = 0; + $TMAX = 213; $XS = 0; } print "1..$TMAX\n"; @@ -1555,4 +1555,21 @@ EOW "\\ octal followed by unicode digit"; TEST q(Data::Dumper->Dumpxs(["\\x00\\x{0660}"])), '\\ octal followed by unicode digit (xs)' if $XS; + + # [perl #118933 - handling of digits +$WANT = <<'EOW'; +#$VAR1 = 0; +#$VAR2 = 1; +#$VAR3 = 90; +#$VAR4 = -10; +#$VAR5 = "010"; +#$VAR6 = 112345678; +#$VAR7 = "1234567890"; +EOW + TEST q(Data::Dumper->Dump([0, 1, 90, -10, "010", "112345678", "1234567890" ])), + "numbers and number-like scalars"; + + TEST q(Data::Dumper->Dumpxs([0, 1, 90, -10, "010", "112345678", "1234567890" ])), + "numbers and number-like scalars" + if $XS; } -- Perl5 Master Repository
