Skip to content

Commit

Permalink
[perl #74798] improved useqq compatibility with the pure perl version
Browse files Browse the repository at this point in the history
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.
  • Loading branch information
tonycoz committed Jul 22, 2013
1 parent d8fe30a commit 059639d
Show file tree
Hide file tree
Showing 2 changed files with 64 additions and 2 deletions.
45 changes: 45 additions & 0 deletions dist/Data-Dumper/Dumper.xs
Expand Up @@ -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)
Expand Down Expand Up @@ -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);
Expand Down
21 changes: 19 additions & 2 deletions dist/Data-Dumper/t/dumper.t
Expand Up @@ -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";
Expand Down Expand Up @@ -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;
}

0 comments on commit 059639d

Please sign in to comment.