From @jkeenan

Created by @jkeenan

Data​::Dumper has both XS and pure-Perl implementations and
is set up such that if your system can run the faster XS
implementation, it will do so except (a) where you choose
not to do so by setting $Data​::Dumper​::Useperl to a true
value (or calling $obj->Useperl(1)); or (b) where the
documentation indicates no XS implementation is available
and the pure-Perl implementation is defaulted to. Cet.
par., the two implementations ought to deliver exactly the
same results.

In the case of $Data​::Dumper​::Freezer = 'foo', or the
equivalent $obj->Freezer('foo'), the XS implementation
differs from the pure-Perl implementation and appears to be
incorrect.

##########

package Test1;
sub new { bless({name => $_[1]}, $_[0]) }
sub freeze {
  my $self = shift;
  $self->{frozed} = 1;
}

package main;
use Data​::Dumper;

my ($obj, $foo);
$foo = Test1->new("foo");

{
  local $Data​::Dumper​::Useperl = 1;
  $obj = Data​::Dumper->new( [ $foo ] );
  $obj->Freezer('freeze');
  print "Freezer method / Perl implementation\n";
  print $obj->Dump;
  print "\n";

  local $Data​::Dumper​::Useperl = 0;
  $obj = Data​::Dumper->new( [ $foo ] );
  $obj->Freezer('freeze');
  print "Freezer method / XS implementation\n";
  print $obj->Dump;
  print "\n";
}

{
  local $Data​::Dumper​::Freezer = 'freeze';

  local $Data​::Dumper​::Useperl = 1;
  $obj = Data​::Dumper->new( [ $foo ] );
  print "Freezer variable set / Perl implementation\n";
  print $obj->Dump;
  print "\n";

  local $Data​::Dumper​::Useperl = 0;
  $obj = Data​::Dumper->new( [ $foo ] );
  print "Freezer variable set / XS implementation\n";
  print $obj->Dump;
}

##########

$> perl freezer.pl

Freezer method / Perl implementation
$VAR1 = bless( {
  'frozed' => 1,
  'name' => 'foo'
  }, 'Test1' );

Freezer method / XS implementation
1$VAR1 = bless( {
  'frozed' => 1,
  'name' => 'foo'
  }, 'Test1' );

Freezer variable set / Perl implementation
$VAR1 = bless( {
  'frozed' => 1,
  'name' => 'foo'
  }, 'Test1' );

Freezer variable set / XS implementation
1$VAR1 = bless( {
  'frozed' => 1,
  'name' => 'foo'
  }, 'Test1' );
##########

Note that in each case the character '1' is erroneously
printed before '$VAR1' in the XS implementation. This is a
bug which would benefit from the attention of someone
familiar with Dumper.xs.

Thank you very much.
Jim Keenan

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

Site configuration information for perl 5.16.0:

Configured by jimk at Sun May 20 20:01:26 EDT 2012.

Summary of my perl5 (revision 5 version 16 subversion 0) configuration:

   Platform:
     osname=darwin, osvers=8.11.0, archname=darwin-2level
     uname='darwin macintosh-8.local 8.11.0 darwin kernel version 
8.11.0: wed oct 10 18:26:00 pdt 2007; root:xnu-792.24.17~1release_ppc 
power macintosh powerpc '
     config_args='-des'
     hint=recommended, useposix=true, d_sigaction=define
     useithreads=undef, usemultiplicity=undef
     useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
     use64bitint=undef, use64bitall=undef, uselongdouble=undef
     usemymalloc=n, bincompat5005=undef
   Compiler:
     cc='cc', ccflags ='-fno-common -DPERL_DARWIN -fno-strict-aliasing 
-pipe -I/usr/local/include -I/opt/local/include',
     optimize='-O3',
     cppflags='-fno-common -DPERL_DARWIN -fno-strict-aliasing -pipe 
-I/usr/local/include -I/opt/local/include'
     ccversion='', gccversion='4.0.1 (Apple Computer, Inc. build 5250)', 
gccosandvers=''
     intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=4321
     d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
     ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', 
lseeksize=8
     alignbytes=8, prototype=define
   Linker and Libraries:
     ld='env MACOSX_DEPLOYMENT_TARGET=10.3 cc', ldflags =' 
-L/usr/local/lib -L/opt/local/lib'
     libpth=/usr/local/lib /opt/local/lib /usr/lib
     libs=-ldbm -ldl -lm -lc
     perllibs=-ldl -lm -lc
     libc=, so=dylib, useshrplib=false, libperl=libperl.a
     gnulibc_version=''
   Dynamic Linking:
     dlsrc=dl_dlopen.xs, dlext=bundle, d_dlsymun=undef, ccdlflags=' '
     cccdlflags=' ', lddlflags=' -bundle -undefined dynamic_lookup 
-L/usr/local/lib -L/opt/local/lib'

Locally applied patches:



@INC for perl 5.16.0:
     /usr/local/lib/perl5/site_perl/5.16.0/darwin-2level
     /usr/local/lib/perl5/site_perl/5.16.0
     /usr/local/lib/perl5/5.16.0/darwin-2level
     /usr/local/lib/perl5/5.16.0
     /usr/local/lib/perl5/site_perl/5.14.2
     /usr/local/lib/perl5/site_perl/5.14.0
     /usr/local/lib/perl5/site_perl/5.12.0
     /usr/local/lib/perl5/site_perl/5.10.1
     /usr/local/lib/perl5/site_perl/5.10.0
     /usr/local/lib/perl5/site_perl
     .


Environment for perl 5.16.0:
 
DYLD_LIBRARY_PATH=/Users/jimk/work/pseudoinstall/lib:/Users/jimk/gitwork/parrot/blib/lib
     HOME=/Users/jimk
     LANG (unset)
     LANGUAGE (unset)
     LD_LIBRARY_PATH (unset)
     LOGDIR (unset)
 
PATH=/usr/local/bin:/opt/local/bin:/opt/local/sbin:/usr/local/bin:/opt/local/bin:/opt/local/sbin:/bin:/sbin:/usr/bin:/usr/sbin:/Users/jimk/bin:/Users/jimk/bin/perl:/Users/jimk/bin/c:/Users/jimk/bin/shell:/sw/lib:/sw/bin:/Users/jimk/bin:/Users/jimk/bin/perl:/Users/jimk/bin/c:/Users/jimk/bin/shell:/sw/lib:/sw/bin
     PERL_BADLANG (unset)
     SHELL=/bin/bash

From @jkeenan

Attaching test program.

From @jkeenan

freezer.pl

From [Unknown Contact. See original ticket]

Attaching test program.

@jkeenan - Status changed from 'new' to 'open'

From @arc

James E Keenan <perlbug-followup@​perl.org> wrote​:

sub freeze {
my $self = shift;
$self->{frozed} = 1;
}
[…]
Freezer method / XS implementation
1$VAR1 = bless( {
'frozed' => 1,
'name' => 'foo'
}, 'Test1' );

The excess 1 is the return value of `freeze`; you can change the 1 to
(say) 17, and it shows up in the output of the XS dumper. `Dump` is
context-sensitive; it returns a list of strings when called in list
context. It looks to me like perhaps the XS implementation can
inappropriately leave the freezer method's return value on the stack.
I don't understand enough of the way Perl's stacks work to properly
track that down in the time I have today, but hopefully this will help
someone else come up with a fix.

--
Aaron Crane ** http​://aaroncrane.co.uk/

From @Leont

On Sat, Jan 12, 2013 at 5​:01 PM, Aaron Crane <perl@​aaroncrane.co.uk> wrote​:

The excess 1 is the return value of `freeze`; you can change the 1 to
(say) 17, and it shows up in the output of the XS dumper. `Dump` is
context-sensitive; it returns a list of strings when called in list
context. It looks to me like perhaps the XS implementation can
inappropriately leave the freezer method's return value on the stack.
I don't understand enough of the way Perl's stacks work to properly
track that down in the time I have today, but hopefully this will help
someone else come up with a fix.

Sounds pretty accurate to me​:

  dSP; ENTER; SAVETMPS; PUSHMARK(sp);
  XPUSHs(val); PUTBACK;
  i = perl_call_method(SvPVX_const(freezer), G_EVAL|G_VOID);
  SPAGAIN;
  if (SvTRUE(ERRSV))
  warn("WARNING(Freezer method call failed)​: %"SVf"", ERRSV);
  PUTBACK; FREETMPS; LEAVE;

That second PUTBACK should probably be a POPs. PUTBACK right after an
SPAGAIN is kind of silly anyway.

Leon

From @Leont

On Sat, Jan 12, 2013 at 5​:19 PM, Leon Timmermans <fawaka@​gmail.com> wrote​:

That second PUTBACK should probably be a POPs. PUTBACK right after an
SPAGAIN is kind of silly anyway.

No wait. PUTBACK right after SPAGAIN is useless, but right after POPs
is quite sensible.

Leon

From mail@steffen-mueller.net

On 01/12/2013 05​:21 PM, Leon Timmermans wrote​:

On Sat, Jan 12, 2013 at 5​:19 PM, Leon Timmermans <fawaka@​gmail.com> wrote​:

That second PUTBACK should probably be a POPs. PUTBACK right after an
SPAGAIN is kind of silly anyway.

No wait. PUTBACK right after SPAGAIN is useless, but right after POPs
is quite sensible.

So any suggestions for a fix? I'm a bit starved for quality time to
recall all the details and figure it out. Seems like you're at least 95%
there.

--Steffen

From @arc

Steffen Mueller <mail@​steffen-mueller.net> wrote​:

So any suggestions for a fix? I'm a bit starved for quality time to recall
all the details and figure it out. Seems like you're at least 95% there.

Does this look sane? I'll apply it if so.

diff --git a/dist/Data-Dumper/Dumper.xs b/dist/Data-Dumper/Dumper.xs
index d7204e1..d0f7145 100644
--- a/dist/Data-Dumper/Dumper.xs
+++ b/dist/Data-Dumper/Dumper.xs
@@ -344,7 +344,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN

diff --git a/dist/Data-Dumper/t/freezer.t b/dist/Data-Dumper/t/freezer.t
index c46d861..a67cc12 100644
--- a/dist/Data-Dumper/t/freezer.t
+++ b/dist/Data-Dumper/t/freezer.t
@@ -25,6 +25,11 @@ ok($dumped_foo,
 like($dumped_foo, qr/frozed/,
      "Dumped string has the key added by Freezer.");

+# test that list-context freeze return doesn't contain the freezer's return
+# value; RT #116364
+like(join(" ", Dumper($foo)), qr/\A\$VAR1 = /,
+     "Dumped list doesn't begin with Freezer's return value");
+
 # run the same tests with useperl.  this always worked
 {
     local $Data::Dumper::Useperl = 1;
@@ -34,6 +39,8 @@ like($dumped_foo, qr/frozed/,
        "Use of freezer sub which returns non-ref worked with useperl");
     like($dumped_foo, qr/frozed/,
          "Dumped string has the key added by Freezer with useperl.");
+    like(join(" ", Dumper($foo)), qr/\A\$VAR1 = /,
+         "Dumped list doesn't begin with Freezer's return value with useperl");
 }

 # test for warning when an object doesn't have a freeze()

-- 

Aaron Crane ** http​://aaroncrane.co.uk/

From @tsee

On 01/13/2013 11​:17 AM, Aaron Crane wrote​:

Steffen Mueller <mail@​steffen-mueller.net> wrote​:

So any suggestions for a fix? I'm a bit starved for quality time to recall
all the details and figure it out. Seems like you're at least 95% there.

Does this look sane? I'll apply it if so.

It does to me.

--Steffen

From @jkeenan

On 1/13/13 5​:17 AM, Aaron Crane wrote​:

Steffen Mueller<mail@​steffen-mueller.net> wrote​:

So any suggestions for a fix? I'm a bit starved for quality time to recall
all the details and figure it out. Seems like you're at least 95% there.

Does this look sane? I'll apply it if so.

I tried it out in my github research branch and all tests pass. Please
apply to blead. Once RT is back up we can close the ticket.

Thank you very much.
Jim Keenan

From @arc

jkeen@​verizon.net wrote​:

I tried it out in my github research branch and all tests pass.
Please apply to blead. Once RT is back up we can close the ticket.

Applied as be022d2, and ticket closed.

Thanks.

--
Aaron Crane ** http​://aaroncrane.co.uk/

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