Skip to content
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

Closed
p5pRT opened this issue Jan 28, 2011 · 14 comments
Closed

Data::Dumper error repeatly serializes #11090

p5pRT opened this issue Jan 28, 2011 · 14 comments

Comments

@p5pRT
Copy link

p5pRT commented Jan 28, 2011

Migrated from rt.perl.org#82948 (status was 'resolved')

Searchable as RT82948$

@p5pRT
Copy link
Author

p5pRT commented Jan 28, 2011

From @unera

Created by @unera

The test that showes the problem​:

=cut

#!/usr/bin/perl

use warnings;
use strict;

use utf8;
use open qw(​:std :utf8);

use Test​::More tests => 5;

BEGIN {
  use_ok 'Data​::Dumper';
}

use Data​::Dumper;
my $test = {
  array => [ qw( a b c ) ],
  hash => { a => 'b', c => 'd' },
  regexp => qr/^(a|b|c)$/,
};

local $Data​::Dumper​::Terse = 1;
local $Data​::Dumper​::Useqq = 1;
local $Data​::Dumper​::Indent = 0;

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';
diag "$dump\n$dump2" unless $eq_res;

=cut

We can't receive the same dump if we will
serialize-deserialize-serialize using Data​::Dumper.

Perl Info

Flags:
    category=library
    severity=low
    module=Data::Dumper

Site configuration information for perl 5.10.1:

Configured by Debian Project at Tue Nov  2 08:37:36 UTC 2010.

Summary of my perl5 (revision 5 version 10 subversion 1) configuration:
   
  Platform:
    osname=linux, osvers=2.6.32-5-amd64, archname=x86_64-linux-gnu-thread-multi
    uname='linux madeleine 2.6.32-5-amd64 #1 smp wed oct 20 00:05:22 utc 2010 x86_64 gnulinux '
    config_args='-Dusethreads -Duselargefiles -Dccflags=-DDEBIAN -Dcccdlflags=-fPIC -Darchname=x86_64-linux-gnu -Dprefix=/usr -Dprivlib=/usr/share/perl/5.10 -Darchlib=/usr/lib/perl/5.10 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/perl5 -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.10.1 -Dsitearch=/usr/local/lib/perl/5.10.1 -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dsiteman1dir=/usr/local/man/man1 -Dsiteman3dir=/usr/local/man/man3 -Dman1ext=1 -Dman3ext=3perl -Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Ud_ualarm -Uusesfio -Uusenm -DDEBUGGING=-g -Doptimize=-O2 -Duseshrplib -Dlibperl=libperl.so.5.10.1 -Dd_dosuid -des'
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=define, usemultiplicity=define
    useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
    use64bitint=define, use64bitall=define, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O2 -g',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include'
    ccversion='', gccversion='4.4.5', gccosandvers=''
    intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
    ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -fstack-protector -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib /lib64 /usr/lib64
    libs=-lgdbm -lgdbm_compat -ldb -ldl -lm -lpthread -lc -lcrypt
    perllibs=-ldl -lm -lpthread -lc -lcrypt
    libc=/lib/libc-2.11.2.so, so=so, useshrplib=true, libperl=libperl.so.5.10.1
    gnulibc_version='2.11.2'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
    cccdlflags='-fPIC', lddlflags='-shared -O2 -g -L/usr/local/lib -fstack-protector'

Locally applied patches:
    DEBPKG:debian/arm_thread_stress_timeout - http://bugs.debian.org/501970 Raise the timeout of ext/threads/shared/t/stress.t to accommodate slower build hosts
    DEBPKG:debian/cpan_config_path - Set location of CPAN::Config to /etc/perl as /usr may not be writable.
    DEBPKG:debian/cpan_definstalldirs - Provide a sensible INSTALLDIRS default for modules installed from CPAN.
    DEBPKG:debian/db_file_ver - http://bugs.debian.org/340047 Remove overly restrictive DB_File version check.
    DEBPKG:debian/doc_info - Replace generic man(1) instructions with Debian-specific information.
    DEBPKG:debian/enc2xs_inc - http://bugs.debian.org/290336 Tweak enc2xs to follow symlinks and ignore missing @INC directories.
    DEBPKG:debian/errno_ver - http://bugs.debian.org/343351 Remove Errno version check due to upgrade problems with long-running processes.
    DEBPKG:debian/extutils_hacks - Various debian-specific ExtUtils changes
    DEBPKG:debian/fakeroot - Postpone LD_LIBRARY_PATH evaluation to the binary targets.
    DEBPKG:debian/instmodsh_doc - Debian policy doesn't install .packlist files for core or vendor.
    DEBPKG:debian/ld_run_path - Remove standard libs from LD_RUN_PATH as per Debian policy.
    DEBPKG:debian/libnet_config_path - Set location of libnet.cfg to /etc/perl/Net as /usr may not be writable.
    DEBPKG:debian/m68k_thread_stress - http://bugs.debian.org/495826 Disable some threads tests on m68k for now due to missing TLS.
    DEBPKG:debian/mod_paths - Tweak @INC ordering for Debian
    DEBPKG:debian/module_build_man_extensions - http://bugs.debian.org/479460 Adjust Module::Build manual page extensions for the Debian Perl policy
    DEBPKG:debian/perl_synopsis - http://bugs.debian.org/278323 Rearrange perl.pod
    DEBPKG:debian/prune_libs - http://bugs.debian.org/128355 Prune the list of libraries wanted to what we actually need.
    DEBPKG:debian/use_gdbm - Explicitly link against -lgdbm_compat in ODBM_File/NDBM_File. 
    DEBPKG:fixes/assorted_docs - http://bugs.debian.org/443733 [384f06a] Math::BigInt::CalcEmu documentation grammar fix
    DEBPKG:fixes/net_smtp_docs - http://bugs.debian.org/100195 [rt.cpan.org #36038] Document the Net::SMTP 'Port' option
    DEBPKG:fixes/processPL - http://bugs.debian.org/357264 [rt.cpan.org #17224] Always use PERLRUNINST when building perl modules.
    DEBPKG:debian/perlivp - http://bugs.debian.org/510895 Make perlivp skip include directories in /usr/local
    DEBPKG:fixes/pod2man-index-backslash - http://bugs.debian.org/521256 Escape backslashes in .IX entries
    DEBPKG:debian/disable-zlib-bundling - Disable zlib bundling in Compress::Raw::Zlib
    DEBPKG:fixes/kfreebsd_cppsymbols - http://bugs.debian.org/533098 [3b910a0] Add gcc predefined macros to $Config{cppsymbols} on GNU/kFreeBSD.
    DEBPKG:debian/cpanplus_definstalldirs - http://bugs.debian.org/533707 Configure CPANPLUS to use the site directories by default.
    DEBPKG:debian/cpanplus_config_path - Save local versions of CPANPLUS::Config::System into /etc/perl.
    DEBPKG:fixes/kfreebsd-filecopy-pipes - http://bugs.debian.org/537555 [16f708c] Fix File::Copy::copy with pipes on GNU/kFreeBSD
    DEBPKG:fixes/anon-tmpfile-dir - http://bugs.debian.org/528544 [perl #66452] Honor TMPDIR when open()ing an anonymous temporary file
    DEBPKG:fixes/abstract-sockets - http://bugs.debian.org/329291 [89904c0] Add support for Abstract namespace sockets.
    DEBPKG:fixes/hurd_cppsymbols - http://bugs.debian.org/544307 [eeb92b7] Add gcc predefined macros to $Config{cppsymbols} on GNU/Hurd.
    DEBPKG:fixes/autodie-flock - http://bugs.debian.org/543731 Allow for flock returning EAGAIN instead of EWOULDBLOCK on linux/parisc
    DEBPKG:fixes/archive-tar-instance-error - http://bugs.debian.org/539355 [rt.cpan.org #48879] Separate Archive::Tar instance error strings from each other
    DEBPKG:fixes/positive-gpos - http://bugs.debian.org/545234 [perl #69056] [c584a96] Fix \\G crash on first match
    DEBPKG:debian/devel-ppport-ia64-optim - http://bugs.debian.org/548943 Work around an ICE on ia64
    DEBPKG:fixes/trie-logic-match - http://bugs.debian.org/552291 [perl #69973] [0abd0d7] Fix a DoS in Unicode processing [CVE-2009-3626]
    DEBPKG:fixes/hppa-thread-eagain - http://bugs.debian.org/554218 make the threads-shared test suite more robust, fixing failures on hppa
    DEBPKG:fixes/crash-on-undefined-destroy - http://bugs.debian.org/564074 [perl #71952] [1f15e67] Fix a NULL pointer dereference when looking for a DESTROY method
    DEBPKG:fixes/tainted-errno - http://bugs.debian.org/574129 [perl #61976] [be1cf43] fix an errno stringification bug in taint mode
    DEBPKG:fixes/safe-upgrade - http://bugs.debian.org/582978 Upgrade Safe.pm to 2.25, fixing CVE-2010-1974
    DEBPKG:fixes/tell-crash - http://bugs.debian.org/578577 [f4817f3] Fix a tell() crash on bad arguments.
    DEBPKG:fixes/format-write-crash - http://bugs.debian.org/579537 [perl #22977] [421f30e] Fix a crash in format/write
    DEBPKG:fixes/arm-alignment - http://bugs.debian.org/289884 [f1c7503] Prevent gcc from optimizing the alignment test away on armel
    DEBPKG:fixes/fcgi-test - Fix a failure in CGI/t/fast.t when FCGI is installed
    DEBPKG:fixes/hurd-ccflags - http://bugs.debian.org/587901 Make hints/gnu.sh append to $ccflags rather than overriding them
    DEBPKG:debian/squelch-locale-warnings - http://bugs.debian.org/508764 Squelch locale warnings in Debian package maintainer scripts
    DEBPKG:fixes/lc-numeric-docs - http://bugs.debian.org/379329 [perl #78452] [903eb63] LC_NUMERIC documentation fixes
    DEBPKG:fixes/lc-numeric-sprintf - http://bugs.debian.org/601549 [perl #78632] [b3fd614] Fix sprintf not to ignore LC_NUMERIC with constants
    DEBPKG:fixes/concat-stack-corruption - http://bugs.debian.org/596105 [perl #78674] [e3393f5] Fix stack pointer corruption in pp_concat() with 'use encoding'
    DEBPKG:patchlevel - http://bugs.debian.org/567489 List packaged patches for 5.10.1-16 in patchlevel.h


@INC for perl 5.10.1:
    /etc/perl
    /usr/local/lib/perl/5.10.1
    /usr/local/share/perl/5.10.1
    /usr/lib/perl5
    /usr/share/perl5
    /usr/lib/perl/5.10
    /usr/share/perl/5.10
    /usr/local/lib/site_perl
    .


Environment for perl 5.10.1:
    HOME=/home/dimka
    LANG=ru_RU.UTF-8
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/usr/local/bin:/usr/bin:/bin:/usr/games
    PERL_BADLANG (unset)
    SHELL=/bin/zsh

@p5pRT
Copy link
Author

p5pRT commented Jan 31, 2011

From @iabyn

On Fri, Jan 28, 2011 at 01​:28​:53AM -0800, unera@​debian.org wrote​:

#!/usr/bin/perl

use warnings;
use strict;

use utf8;
use open qw(​:std :utf8);

use Test​::More tests => 5;

BEGIN {
use_ok 'Data​::Dumper';
}

use Data​::Dumper;
my $test = {
array => [ qw( a b c ) ],
hash => { a => 'b', c => 'd' },
regexp => qr/^(a|b|c)$/,
};

local $Data​::Dumper​::Terse = 1;
local $Data​::Dumper​::Useqq = 1;
local $Data​::Dumper​::Indent = 0;

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';
diag "$dump\n$dump2" unless $eq_res;

=cut

We can't receive the same dump if we will
serialize-deserialize-serialize using Data​::Dumper.

Data​::Dumper makes no guarantees that the result of repeated
serialisations will result in the same string; only that they will
be functionally equivalent. What you are seeing is mostly the result of
hash keys being unordered, and thus appearing in differing orders in
different serialisations. If this bothers you, then you could use

  local $Data​::Dumper​::Sortkeys = 1;

The only thing that differs then is the regexp serialisation, which
accrues multiple sets of flags. This is ugly, but still functionally
equivalent; although I guess we should fix that just for prettiness sake​:

  qr/^(a|b|c)$/
becomes qr/(?-xism​:^(a|b|c)$)/
becomes qr/(?-xism​:(?-xism​:^(a|b|c)$))/
....

and similar with (?^ in 5.13.x.

--
"You're so sadly neglected, and often ignored.
A poor second to Belgium, When going abroad."
  -- Monty Python, "Finland"

@p5pRT
Copy link
Author

p5pRT commented Jan 31, 2011

The RT System itself - Status changed from 'new' to 'open'

@p5pRT
Copy link
Author

p5pRT commented Jan 31, 2011

From @demerphq

On 31 January 2011 12​:17, Dave Mitchell <davem@​iabyn.com> wrote​:

On Fri, Jan 28, 2011 at 01​:28​:53AM -0800, unera@​debian.org wrote​:

#!/usr/bin/perl

use warnings;
use strict;

use utf8;
use open qw(​:std :utf8);

use Test​::More tests => 5;

BEGIN {
    use_ok 'Data​::Dumper';
}

use Data​::Dumper;
my $test = {
    array   => [ qw( a b c ) ],
    hash    => { a => 'b', c => 'd' },
    regexp  => qr/^(a|b|c)$/,
};

local $Data​::Dumper​::Terse = 1;
local $Data​::Dumper​::Useqq = 1;
local $Data​::Dumper​::Indent = 0;

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';
diag "$dump\n$dump2" unless $eq_res;

=cut

We can't receive the same dump if we will
serialize-deserialize-serialize using Data​::Dumper.

Data​::Dumper makes no guarantees that the result of repeated
serialisations will result in the same string; only that they will
be functionally equivalent. What you are seeing is mostly the result of
hash keys being unordered, and thus appearing in differing orders in
different serialisations. If this bothers you, then you could use

   local $Data​::Dumper​::Sortkeys = 1;

The only thing that differs then is the regexp serialisation, which
accrues multiple sets of flags. This is ugly, but still functionally
equivalent; although I guess we should fix that just for prettiness sake​:

       qr/^(a|b|c)$/
becomes qr/(?-xism​:^(a|b|c)$)/
becomes qr/(?-xism​:(?-xism​:^(a|b|c)$))/
....

and similar with (?^ in 5.13.x.

Data​::Dump​::Streamer does this properly, and there is no longer any
reason that DD does not. The routine that DDS uses for this has been
in core in the re namespace for some time​:

my ($pat,$mods)=regexp_pattern(qr/foo/i);

So DD could use it to extract the flags and pattern without them being
wrapped in (?...) brackets, and thus round trip regexen properly.

One of the reasons that I wrote DDS was that DD doesn't/didn't handle
certain structures properly, including regexes, and especially
_blessed_ regexes.

Example​:

$ perl -MData​::Dump​::Streamer -e'my ($x,$y); $x=\$y; $y=\$x; print Dump($x,$y)'
$REF1 = \$REF2;
$REF2 = \$REF1;

$ perl -MData​::Dumper -e'my ($x,$y); $x=\$y; $y=\$x; print Dumper($x,$y)'
$VAR1 = \\$VAR1;
$VAR2 = ${$VAR1};

Perhaps the OP should try using it instead, although it is MUCH
slower. But also much more accurate.

Alternatively they maybe should investigate using storable.

Yves

--
perl -Mre=debug -e "/just|another|perl|hacker/"

@p5pRT
Copy link
Author

p5pRT commented Nov 21, 2013

From @tonycoz

On Mon Jan 31 03​:33​:15 2011, demerphq wrote​:

Data​::Dump​::Streamer does this properly, and there is no longer any
reason that DD does not. The routine that DDS uses for this has been
in core in the re namespace for some time​:

my ($pat,$mods)=regexp_pattern(qr/foo/i);

So DD could use it to extract the flags and pattern without them being
wrapped in (?...) brackets, and thus round trip regexen properly.

Data​::Dumper has code to do this, but it's only used when the regexp is blessed into
another package.

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

@p5pRT
Copy link
Author

p5pRT commented Nov 21, 2013

From @tonycoz

0002-bump-Data-Dumper-VERSION.patch
From 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

@p5pRT
Copy link
Author

p5pRT commented Dec 2, 2013

From @tonycoz

On Wed Nov 20 21​:56​:29 2013, tonyc wrote​:

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?

Oops, somehow I missed adding the actually useful patch.

Here it is, I hope.

Tony

@p5pRT
Copy link
Author

p5pRT commented Dec 2, 2013

From @tonycoz

0001-perl-82948-use-re-regexp_pattern-in-list-context-for.patch
From 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

@p5pRT
Copy link
Author

p5pRT commented Dec 2, 2013

From @tonycoz

On Wed Nov 20 21​:56​:29 2013, tonyc wrote​:

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.

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
probably introduce a syntax error, eg​:

qr/a(?{ ++y
})/

might become​:

qr/a(?{ ++y\n})/

Tony

@p5pRT
Copy link
Author

p5pRT commented Dec 3, 2013

From @iabyn

On Mon, Dec 02, 2013 at 02​:41​:34PM -0800, Tony Cook via RT wrote​:

On Wed Nov 20 21​:56​:29 2013, tonyc wrote​:

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.

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
probably introduce a syntax error, eg​:

qr/a(?{ ++y
})/

might become​:

qr/a(?{ ++y\n})/

Tony

although in 5.18 onwards, the char indices of the start and end of the
text of code blocks is stored in the regex, in the code_blocks field
of the regexp_internal struct - so they could in theory be skipped over.

--
The crew of the Enterprise encounter an alien life form which is
surprisingly neither humanoid nor made from pure energy.
  -- Things That Never Happen in "Star Trek" #22

@p5pRT
Copy link
Author

p5pRT commented Dec 17, 2013

From @tonycoz

On Sun Dec 01 19​:48​:17 2013, tonyc wrote​:

On Wed Nov 20 21​:56​:29 2013, tonyc wrote​:

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?

Oops, somehow I missed adding the actually useful patch.

Here it is, I hope.

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
dumps.

Leaving this ticket open for a) the fall-out, b) maybe I'll follow Dave's suggestion about codeblocks.

Tony

@p5pRT
Copy link
Author

p5pRT commented Dec 24, 2013

From @demerphq

On 17 December 2013 06​:52, Tony Cook via RT <perlbug-followup@​perl.org> wrote​:

On Sun Dec 01 19​:48​:17 2013, tonyc wrote​:

On Wed Nov 20 21​:56​:29 2013, tonyc wrote​:

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?

Oops, somehow I missed adding the actually useful patch.

Here it is, I hope.

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
dumps.

Leaving this ticket open for a) the fall-out, b) maybe I'll follow Dave's suggestion about codeblocks.

Thanks a lot for the work Tony. If you ever make it to Amsterdam the
beer is on me.

Yves

--
perl -Mre=debug -e "/just|another|perl|hacker/"

@p5pRT
Copy link
Author

p5pRT commented Jan 28, 2014

From @tonycoz

On Mon Dec 16 21​:52​:21 2013, tonyc wrote​:

On Sun Dec 01 19​:48​:17 2013, tonyc wrote​:

On Wed Nov 20 21​:56​:29 2013, tonyc wrote​:

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?

Oops, somehow I missed adding the actually useful patch.

Here it is, I hope.

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
dumps.

Leaving this ticket open for a) the fall-out, b) maybe I'll follow
Dave's suggestion about codeblocks.

No BBC reports, closing.

Tony

@p5pRT
Copy link
Author

p5pRT commented Jan 28, 2014

@tonycoz - Status changed from 'open' to 'resolved'

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

1 participant