New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Data::Dumper error repeatly serializes #11090
Comments
From @uneraCreated by @uneraThe test that showes the problem: =cut #!/usr/bin/perl use warnings; use utf8; use Test::More tests => 5; BEGIN { use Data::Dumper; local $Data::Dumper::Terse = 1; my $dump = Dumper($test); ok $dump, 'Dump'; my $o = eval $dump; ok !$@, 'Eval'; my $dump2 = Dumper($o); ok $dump2, 'Dump after Eval'; my $eq_res = ok $dump eq $dump2, 'Dumps are equal'; =cut We can't receive the same dump if we will Perl Info
|
From @iabynOn Fri, Jan 28, 2011 at 01:28:53AM -0800, unera@debian.org wrote:
Data::Dumper makes no guarantees that the result of repeated local $Data::Dumper::Sortkeys = 1; The only thing that differs then is the regexp serialisation, which qr/^(a|b|c)$/ and similar with (?^ in 5.13.x. -- |
The RT System itself - Status changed from 'new' to 'open' |
From @demerphqOn 31 January 2011 12:17, Dave Mitchell <davem@iabyn.com> wrote:
Data::Dump::Streamer does this properly, and there is no longer any my ($pat,$mods)=regexp_pattern(qr/foo/i); So DD could use it to extract the flags and pattern without them being One of the reasons that I wrote DDS was that DD doesn't/didn't handle Example: $ perl -MData::Dump::Streamer -e'my ($x,$y); $x=\$y; $y=\$x; print Dump($x,$y)' $ perl -MData::Dumper -e'my ($x,$y); $x=\$y; $y=\$x; print Dumper($x,$y)' Perhaps the OP should try using it instead, although it is MUCH Alternatively they maybe should investigate using storable. Yves -- |
From @tonycozOn Mon Jan 31 03:33:15 2011, demerphq wrote:
Data::Dumper has code to do this, but it's only used when the regexp is blessed into And the XS Dumper doesn't do it at all. I've attached a patch that modifies Data::Dumper to dump regexp objects using the list form of regexp_pattern(), both in the perl and XS code paths. Is this the desired behaviour? One thing neither the old nor the new code handles specially is regexps containing control characters or unicode - they're simply included as is in the dumped string, I bring this up since the discussion in 113088 implied that it was useful for Data::Dumper to produce pure ASCII. Tony |
From @tonycoz0002-bump-Data-Dumper-VERSION.patchFrom dd666bb054672337cc44f32e00d1fa16cbcdf700 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Thu, 21 Nov 2013 16:48:13 +1100
Subject: [PATCH 2/2] bump $Data::Dumper::VERSION
---
dist/Data-Dumper/Dumper.pm | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/dist/Data-Dumper/Dumper.pm b/dist/Data-Dumper/Dumper.pm
index 0f85393..96ff492 100644
--- a/dist/Data-Dumper/Dumper.pm
+++ b/dist/Data-Dumper/Dumper.pm
@@ -10,7 +10,7 @@
package Data::Dumper;
BEGIN {
- $VERSION = '2.149'; # Don't forget to set version and release
+ $VERSION = '2.150'; # Don't forget to set version and release
} # date in POD below!
#$| = 1;
@@ -1390,7 +1390,7 @@ modify it under the same terms as Perl itself.
=head1 VERSION
-Version 2.149 (September 20 2013)
+Version 2.150 (November 21 2013)
=head1 SEE ALSO
--
1.7.10.4
|
From @tonycozOn Wed Nov 20 21:56:29 2013, tonyc wrote:
Oops, somehow I missed adding the actually useful patch. Here it is, I hope. Tony |
From @tonycoz0001-perl-82948-use-re-regexp_pattern-in-list-context-for.patchFrom 95df91ef58636640cdeae03a93a8173029ecfb1d Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Thu, 21 Nov 2013 16:46:19 +1100
Subject: [perl #82948] use re::regexp_pattern in list context for dumping
qr//
---
dist/Data-Dumper/Dumper.pm | 18 ++++--------------
dist/Data-Dumper/Dumper.xs | 42 +++++++++++++++++++++++++++++++++++++++---
dist/Data-Dumper/t/bless.t | 2 +-
dist/Data-Dumper/t/dumper.t | 20 ++++++++++++++++++--
4 files changed, 62 insertions(+), 20 deletions(-)
diff --git a/dist/Data-Dumper/Dumper.pm b/dist/Data-Dumper/Dumper.pm
index 5b31d2c..0f85393 100644
--- a/dist/Data-Dumper/Dumper.pm
+++ b/dist/Data-Dumper/Dumper.pm
@@ -363,25 +363,15 @@ sub _dump {
if ($is_regex) {
my $pat;
- # This really sucks, re:regexp_pattern is in ext/re/re.xs and not in
- # universal.c, and even worse we cant just require that re to be loaded
- # we *have* to use() it.
- # We should probably move it to universal.c for 5.10.1 and fix this.
- # Currently we only use re::regexp_pattern when the re is blessed into another
- # package. This has the disadvantage of meaning that a DD dump won't round trip
- # as the pattern will be repeatedly wrapped with the same modifiers.
- # This is an aesthetic issue so we will leave it for now, but we could use
- # regexp_pattern() in list context to get the modifiers separately.
- # But since this means loading the full debugging engine in process we wont
- # bother unless its necessary for accuracy.
- if (($realpack ne 'Regexp') && defined(*re::regexp_pattern{CODE})) {
- $pat = re::regexp_pattern($val);
+ my $flags = "";
+ if (defined(*re::regexp_pattern{CODE})) {
+ ($pat, $flags) = re::regexp_pattern($val);
}
else {
$pat = "$val";
}
$pat =~ s <(\\.)|/> { $1 || '\\/' }ge;
- $out .= "qr/$pat/";
+ $out .= "qr/$pat/$flags";
}
elsif ($realtype eq 'SCALAR' || $realtype eq 'REF'
|| $realtype eq 'VSTRING') {
diff --git a/dist/Data-Dumper/Dumper.xs b/dist/Data-Dumper/Dumper.xs
index 65d37c6..0bdcbe0 100644
--- a/dist/Data-Dumper/Dumper.xs
+++ b/dist/Data-Dumper/Dumper.xs
@@ -585,9 +585,43 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
if (is_regex)
{
STRLEN rlen;
- const char *rval = SvPV(val, rlen);
- const char * const rend = rval+rlen;
- const char *slash = rval;
+ SV *sv_pattern = NULL;
+ SV *sv_flags = NULL;
+ CV *re_pattern_cv;
+ const char *rval;
+ const char *rend;
+ const char *slash;
+
+ if ((re_pattern_cv = get_cv("re::regexp_pattern", 0))) {
+ dSP;
+ I32 count;
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ XPUSHs(val);
+ PUTBACK;
+ count = call_sv((SV*)re_pattern_cv, G_ARRAY);
+ SPAGAIN;
+ if (count >= 2) {
+ sv_flags = POPs;
+ sv_pattern = POPs;
+ SvREFCNT_inc(sv_flags);
+ SvREFCNT_inc(sv_pattern);
+ }
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+ if (sv_pattern) {
+ sv_2mortal(sv_pattern);
+ sv_2mortal(sv_flags);
+ }
+ }
+ else {
+ sv_pattern = val;
+ }
+ rval = SvPV(sv_pattern, rlen);
+ rend = rval+rlen;
+ slash = rval;
sv_catpvn(retval, "qr/", 3);
for (;slash < rend; slash++) {
if (*slash == '\\') { ++slash; continue; }
@@ -600,6 +634,8 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
}
sv_catpvn(retval, rval, rlen);
sv_catpvn(retval, "/", 1);
+ if (sv_flags)
+ sv_catsv(retval, sv_flags);
}
else if (
#if PERL_VERSION < 9
diff --git a/dist/Data-Dumper/t/bless.t b/dist/Data-Dumper/t/bless.t
index 9866ea7..202e348 100644
--- a/dist/Data-Dumper/t/bless.t
+++ b/dist/Data-Dumper/t/bless.t
@@ -50,7 +50,7 @@ SKIP: {
my $t = bless( qr//, 'foo');
my $dt = Dumper($t);
my $o = ($] >= 5.013006 ? <<'PERL' : <<'PERL_LEGACY');
-$VAR1 = bless( qr/(?^:)/, 'foo' );
+$VAR1 = bless( qr//, 'foo' );
PERL
$VAR1 = bless( qr/(?-xism:)/, 'foo' );
PERL_LEGACY
diff --git a/dist/Data-Dumper/t/dumper.t b/dist/Data-Dumper/t/dumper.t
index dbc6d5e..f904408 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 = 426; $XS = 1;
+ $TMAX = 432; $XS = 1;
}
else {
print "### XS extensions not loaded, will NOT run XS tests\n";
- $TMAX = 213; $XS = 0;
+ $TMAX = 216; $XS = 0;
}
print "1..$TMAX\n";
@@ -1573,3 +1573,19 @@ EOW
"numbers and number-like scalars"
if $XS;
}
+############# 426
+{
+ # [perl #82948]
+ # re::regexp_pattern was moved to universal.c in v5.10.0-252-g192c1e2
+ $WANT = $] >= 5.012 ? <<'NEW' : <<'OLD';
+#$VAR1 = qr/abc/;
+#$VAR2 = qr/abc/i;
+NEW
+#$VAR1 = qr/(?^:abc)/;
+#$VAR2 = qr/(?^i:abc)/;
+OLD
+ TEST q(Data::Dumper->Dump([ qr/abc/, qr/abc/i ])), "qr//";
+ TEST q(Data::Dumper->Dumpxs([ qr/abc/, qr/abc/i ])), "qr// xs"
+ if $XS;
+}
+############# 432
--
1.7.10.4
|
From @tonycozOn Wed Nov 20 21:56:29 2013, tonyc wrote:
This can't really be made to work (without reparsing the regexp), since the regexp may contain code blocks, and replacing eg and literal newline inside a code block would qr/a(?{ ++y might become: qr/a(?{ ++y\n})/ Tony |
From @iabynOn Mon, Dec 02, 2013 at 02:41:34PM -0800, Tony Cook via RT wrote:
although in 5.18 onwards, the char indices of the start and end of the -- |
From @tonycozOn Sun Dec 01 19:48:17 2013, tonyc wrote:
I've applied this as b183d51 with some test adjustments to work on older perls. Let's see how many CPAN modules test against the literal output of Data::Dumper Leaving this ticket open for a) the fall-out, b) maybe I'll follow Dave's suggestion about codeblocks. Tony |
From @demerphqOn 17 December 2013 06:52, Tony Cook via RT <perlbug-followup@perl.org> wrote:
Thanks a lot for the work Tony. If you ever make it to Amsterdam the Yves -- |
From @tonycozOn Mon Dec 16 21:52:21 2013, tonyc wrote:
No BBC reports, closing. Tony |
@tonycoz - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#82948 (status was 'resolved')
Searchable as RT82948$
The text was updated successfully, but these errors were encountered: