package Data::Dumper;
-$VERSION = '2.135_02'; # Don't forget to set version and release date in POD!
+BEGIN {
+ $VERSION = '2.135_02'; # Don't forget to set version and release
+} # date in POD!
#$| = 1;
# toggled on load failure.
eval {
require XSLoader;
- };
- $Useperl = 1 if $@;
+ }
+ ? XSLoader::load( 'Data::Dumper' )
+ : ($Useperl = 1);
}
-XSLoader::load( 'Data::Dumper' ) unless $Useperl;
-
# module vars and their defaults
$Indent = 2 unless defined $Indent;
$Purity = 0 unless defined $Purity;
return "'" . $val . "'";
}
+# Old Perls (5.14-) have trouble resetting vstring magic when it is no
+# longer valid.
+use constant _bad_vsmg => defined &_vstring && (_vstring(~v0)||'') eq "v0";
+
#
# twist, toil and turn;
# and recurse, of course.
$pat =~ s,/,\\/,g;
$out .= "qr/$pat/";
}
- elsif ($realtype eq 'SCALAR' || $realtype eq 'REF') {
+ elsif ($realtype eq 'SCALAR' || $realtype eq 'REF'
+ || $realtype eq 'VSTRING') {
if ($realpack) {
$out .= 'do{\\(my $o = ' . $s->_dump($$val, "\${$name}") . ')}';
}
else { # simple scalar
my $ref = \$_[1];
+ my $v;
# first, catalog the scalar
if ($name ne '') {
$id = format_refaddr($ref);
elsif (!defined($val)) {
$out .= "undef";
}
+ elsif (defined &_vstring and $v = _vstring($val)
+ and !_bad_vsmg || eval $v eq $val) {
+ $out .= $v;
+ }
+ elsif (!defined &_vstring
+ and ref \$val eq 'VSTRING' || eval{Scalar::Util::isvstring($val)}) {
+ $out .= sprintf "%vd", $val;
+ }
elsif ($val =~ /^(?:0|-?[1-9]\d{0,8})\z/) { # safe decimal number
$out .= $val;
}
}
else {
STRLEN i;
+ const MAGIC *mg;
if (namelen) {
#ifdef DD_USE_OLD_ID_FORMAT
else if (val == &PL_sv_undef || !SvOK(val)) {
sv_catpvn(retval, "undef", 5);
}
+#ifdef SvVOK
+ else if (SvMAGICAL(val) && (mg = mg_find(val, 'V'))) {
+# ifndef PL_vtbl_vstring
+ SV * const vecsv = sv_newmortal();
+# if PERL_VERSION < 10
+ scan_vstring(mg->mg_ptr, vecsv);
+# else
+ scan_vstring(mg->mg_ptr, mg->mg_ptr + mg->mg_len, vecsv);
+# endif
+ if (!sv_eq(vecsv, val)) goto integer_came_from_string;
+# endif
+ sv_catpvn(retval, (const char *)mg->mg_ptr, mg->mg_len);
+ }
+#endif
else {
integer_came_from_string:
c = SvPV(val, i);
if (gimme == G_SCALAR)
XPUSHs(sv_2mortal(retval));
}
+
+SV *
+Data_Dumper__vstring(sv)
+ SV *sv;
+ PROTOTYPE: $
+ CODE:
+ {
+#ifdef SvVOK
+ const MAGIC *mg;
+ RETVAL =
+ SvMAGICAL(sv) && (mg = mg_find(sv, 'V'))
+ ? newSVpvn((const char *)mg->mg_ptr, mg->mg_len)
+ : &PL_sv_undef;
+#else
+ RETVAL = &PL_sv_undef;
+#endif
+ }
+ OUTPUT: RETVAL
$Data::Dumper::Useperl = 1;
if (defined &Data::Dumper::Dumpxs) {
print "### XS extension loaded, will run XS tests\n";
- $TMAX = 378; $XS = 1;
+ $TMAX = 384; $XS = 1;
}
else {
print "### XS extensions not loaded, will NOT run XS tests\n";
- $TMAX = 189; $XS = 0;
+ $TMAX = 192; $XS = 0;
}
print "1..$TMAX\n";
TEST q(Dumper($foo)), 'All latin1 characters with utf8 flag including a wide character';
for (1..3) { print "not ok " . (++$TNUM) . " # TODO NYI\n" if $XS } # TEST q(Data::Dumper::DumperX($foo)) if $XS;
}
+
+############# 378
+{
+ # If XS cannot load, the pure-Perl version cannot deparse vstrings with
+ # underscores properly. In 5.8.0, vstrings are just strings.
+ $WANT = $] > 5.0080001 ? $XS ? <<'EOT' : <<'EOV' : <<'EOU';
+#$a = \v65.66.67;
+#$b = \v65.66.067;
+#$c = \v65.66.6_7;
+#$d = \'ABC';
+EOT
+#$a = \v65.66.67;
+#$b = \v65.66.67;
+#$c = \v65.66.67;
+#$d = \'ABC';
+EOV
+#$a = \'ABC';
+#$b = \'ABC';
+#$c = \'ABC';
+#$d = \'ABC';
+EOU
+ @::_v = (\v65.66.67, \v65.66.067, \v65.66.6_7, \~v190.189.188);
+ TEST q(Data::Dumper->Dump(\@::_v, [qw(a b c d)])), 'vstrings';
+ TEST q(Data::Dumper->Dumpxs(\@::_v, [qw(a b c d)])), 'xs vstrings'
+ if $XS;
+}