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

Bizarre copy of ARRAY in sassign at Carp/Heavy.pm #9282

Open
p5pRT opened this issue Apr 8, 2008 · 40 comments
Open

Bizarre copy of ARRAY in sassign at Carp/Heavy.pm #9282

p5pRT opened this issue Apr 8, 2008 · 40 comments

Comments

@p5pRT
Copy link
Collaborator

@p5pRT p5pRT commented Apr 8, 2008

Migrated from rt.perl.org#52610 (status was 'open')

Searchable as RT52610$

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Apr 8, 2008

From chris@heathens.co.nz

This is a bug report for perl from chris@​heathens.co.nz,
generated with the help of perlbug 1.35 running under perl v5.8.8.


The following test program gives this error​:

Bizarre copy of ARRAY in sassign at /usr/lib/perl5/5.8.8/Carp/Heavy.pm line 45.

Tested on the 5.8.x branch and on perl-current.

use Carp;

sub do_carp {
  print Carp​::longmess;
}

sub call_with_args {
  my ($arg_hash, $func) = @​_;
  $func->(@​{$arg_hash->{'args'}});
}

my $h = {};
# Deleting the undef makes it all work again!
my $arg_hash = {'args' => [undef]};
call_with_args($arg_hash, sub {
  $arg_hash->{'args'} = [];
  do_carp(sub { $h; });
});



Flags​:
  category=core
  severity=low


This perlbug was built using Perl v5.8.8 in the Red Hat build system.
It is being executed now by Perl v5.8.8 - Thu Jan 31 13​:32​:29 EST 2008.

Site configuration information for perl v5.8.8​:

Configured by Red Hat, Inc. at Thu Jan 31 13​:32​:29 EST 2008.

Summary of my perl5 (revision 5 version 8 subversion 8) configuration​:
  Platform​:
  osname=linux, osvers=2.6.18-53.1.4.el5.bz358661.1, archname=i386-linux-thread-multi
  uname='linux hammer2.fedora.redhat.com 2.6.18-53.1.4.el5.bz358661.1 #1 smp tue dec 18 14​:48​:27 est 2007 i686 athlon i386 gnulinux '
  config_args='-des -Doptimize=-O2 -g -pipe -Wall -Wp,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector --param=ssp-buffer-size=4 -m32 -march=i386 -mtune=generic -fasynchronous-unwind-tables -Dversion=5.8.8 -Dmyhostname=localhost -Dperladmin=root@​localhost -Dcc=gcc -Dcf_by=Red Hat, Inc. -Dinstallprefix=/usr -Dprefix=/usr -Darchname=i386-linux -Dvendorprefix=/usr -Dsiteprefix=/usr -Duseshrplib -Dusethreads -Duseithreads -Duselargefiles -Dd_dosuid -Dd_semctl_semun -Di_db -Ui_ndbm -Di_gdbm -Di_shadow -Di_syslog -Dman3ext=3pm -Duseperlio -Dinstallusrbinperl=n -Ubincompat5005 -Uversiononly -Dpager=/usr/bin/less -isr -Dd_gethostent_r_proto -Ud_endhostent_r_proto -Ud_sethostent_r_proto -Ud_endprotoent_r_proto -Ud_setprotoent_r_proto -Ud_endservent_r_proto -Ud_setservent_r_proto -Dinc_version_list=5.8.7 5.8.6 5.8.5 -Dscriptdir=/usr/bin'
  hint=recommended, useposix=true, d_sigaction=define
  usethreads=define use5005threads=undef useithreads=define usemultiplicity=define
  useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
  use64bitint=undef use64bitall=undef uselongdouble=undef
  usemymalloc=n, bincompat5005=undef
  Compiler​:
  cc='gcc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -fno-strict-aliasing -pipe -Wdeclaration-after-statement -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -I/usr/include/gdbm',
  optimize='-O2 -g -pipe -Wall -Wp,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector --param=ssp-buffer-size=4 -m32 -march=i386 -mtune=generic -fasynchronous-unwind-tables',
  cppflags='-D_REENTRANT -D_GNU_SOURCE -fno-strict-aliasing -pipe -Wdeclaration-after-statement -I/usr/local/include -I/usr/include/gdbm'
  ccversion='', gccversion='4.1.2 20070925 (Red Hat 4.1.2-27)', gccosandvers=''
  intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
  d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
  ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
  alignbytes=4, prototype=define
  Linker and Libraries​:
  ld='gcc', ldflags =' -L/usr/local/lib'
  libpth=/usr/local/lib /lib /usr/lib
  libs=-lresolv -lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lpthread -lc
  perllibs=-lresolv -lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
  libc=/lib/libc-2.6.so, so=so, useshrplib=true, libperl=libperl.so
  gnulibc_version='2.6'
  Dynamic Linking​:
  dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E -Wl,-rpath,/usr/lib/perl5/5.8.8/i386-linux-thread-multi/CORE'
  cccdlflags='-fPIC', lddlflags='-shared -O2 -g -pipe -Wall -Wp,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector --param=ssp-buffer-size=4 -m32 -march=i386 -mtune=generic -fasynchronous-unwind-tables -L/usr/local/lib'

Locally applied patches​:
 


@​INC for perl v5.8.8​:
  /usr/lib/perl5/site_perl/5.8.8/i386-linux-thread-multi
  /usr/lib/perl5/site_perl/5.8.7/i386-linux-thread-multi
  /usr/lib/perl5/site_perl/5.8.6/i386-linux-thread-multi
  /usr/lib/perl5/site_perl/5.8.5/i386-linux-thread-multi
  /usr/lib/perl5/site_perl/5.8.8
  /usr/lib/perl5/site_perl/5.8.7
  /usr/lib/perl5/site_perl/5.8.6
  /usr/lib/perl5/site_perl/5.8.5
  /usr/lib/perl5/site_perl
  /usr/lib/perl5/vendor_perl/5.8.8/i386-linux-thread-multi
  /usr/lib/perl5/vendor_perl/5.8.7/i386-linux-thread-multi
  /usr/lib/perl5/vendor_perl/5.8.6/i386-linux-thread-multi
  /usr/lib/perl5/vendor_perl/5.8.5/i386-linux-thread-multi
  /usr/lib/perl5/vendor_perl/5.8.8
  /usr/lib/perl5/vendor_perl/5.8.7
  /usr/lib/perl5/vendor_perl/5.8.6
  /usr/lib/perl5/vendor_perl/5.8.5
  /usr/lib/perl5/vendor_perl
  /usr/lib/perl5/5.8.8/i386-linux-thread-multi
  /usr/lib/perl5/5.8.8
  .


Environment for perl v5.8.8​:
  HOME=/home/chris
  LANG=en_NZ.UTF-8
  LANGUAGE (unset)
  LD_LIBRARY_PATH (unset)
  LOGDIR (unset)
  PATH=/usr/lib/qt-3.3/bin​:/usr/kerberos/bin​:/usr/local/bin​:/usr/bin​:/bin​:/home/chris/bin​:/sbin​:/usr/sbin​:/usr/local/sbin
  PERL_BADLANG (unset)
  SHELL=/bin/bash

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Apr 15, 2008

From @nwc10

On Tue, Apr 08, 2008 at 11​:39​:25AM -0700, Chris Heath wrote​:

The following test program gives this error​:

Bizarre copy of ARRAY in sassign at /usr/lib/perl5/5.8.8/Carp/Heavy.pm line 45.

Tested on the 5.8.x branch and on perl-current.

use Carp;

sub do_carp {
print Carp​::longmess;
}

sub call_with_args {
my ($arg_hash, $func) = @​_;
$func->(@​{$arg_hash->{'args'}});
}

my $h = {};
# Deleting the undef makes it all work again!
my $arg_hash = {'args' => [undef]};
call_with_args($arg_hash, sub {
$arg_hash->{'args'} = [];
do_carp(sub { $h; });
});

Thanks for this bug report. The error has been seen before, but not with this
concise a test case. I can reduce it down to this​:

$ cat C.pm
package C;
sub longmess_real {
  package DB;
  () = caller(2);

  use Devel​::Peek; Dump \@​DB​::args;

  foreach(@​DB​::args) {
  my $a = $_;
  }
}

1;
__END__
$ cat 52610
sub longmess {
  require C;
  goto &C​::longmess_real;
}

sub do_carp {
  longmess;
}

sub call_with_args {
  my ($arg_hash, $func) = @​_;
  $func->(@​{$arg_hash->{'args'}});
}

my $h = {};
# Deleting the undef makes it all work again!
my $arg_hash = {'args' => [undef]};
call_with_args($arg_hash, sub {
  $arg_hash->{'args'} = [];
  do_carp(sub { $h; });
});
__END__
$ ./perl -Ilib 52610
SV = IV(0x10081d9a0) at 0x10081d9a8
  REFCNT = 1
  FLAGS = (TEMP,ROK)
  RV = 0x10081dbd0
  SV = PVAV(0x1008059e8) at 0x10081dbd0
  REFCNT = 2
  FLAGS = ()
  ARRAY = 0x10050b538
  FILL = 0
  MAX = 3
  ARYLEN = 0x0
  FLAGS = ()
  Elt No. 0
  SV = PVAV(0x100805808) at 0x10081d738
  REFCNT = 1
  FLAGS = ()
  ARRAY = 0x10050b4c8
  FILL = 1
  MAX = 3
  ARYLEN = 0x0
  FLAGS = (REAL)
  Elt No. 0
  Elt No. 1
  SV = PVNV(0x100802f18) at 0x10081d828
  REFCNT = 2
  FLAGS = (POK,FAKE,pPOK)
  IV = 0
  NV = 1.97626258336499e-323
  PV = 0x10050d2f8 "$h"\0
  CUR = 2
  LEN = 8
Bizarre copy of ARRAY in sassign at C.pm line 9.

[the line with Devel​::Peek is optional]

It looks like the address of something on Perl's stack ends up being re-used
as something (else) that points into a PAD. I'm not entirely sure why, and
it's something "special" with how caller and package DB interact.

Nicholas Clark

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Apr 15, 2008

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

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Feb 14, 2009

From p5p@spam.wizbit.be

Thanks for this bug report. The error has been seen before, but not
with this
concise a test case. I can reduce it down to this​:

$ cat C.pm
package C;
sub longmess_real {
package DB;
() = caller(2);

use Devel​::Peek; Dump \@​DB​::args;

foreach(@​DB​::args) {
my $a = $_;
}
}

1;
__END__
$ cat 52610
sub longmess {
require C;
goto &C​::longmess_real;
}

sub do_carp {
longmess;
}

sub call_with_args {
my ($arg_hash, $func) = @​_;
$func->(@​{$arg_hash->{'args'}});
}

my $h = {};
# Deleting the undef makes it all work again!
my $arg_hash = {'args' => [undef]};
call_with_args($arg_hash, sub {
$arg_hash->{'args'} = [];
do_carp(sub { $h; });
});
__END__

'# Deleting the undef makes it all work again!'
=> This is not correct. The problem was only invisible because the
array was empty.

[...]

It looks like the address of something on Perl's stack ends up being
re-used
as something (else) that points into a PAD. I'm not entirely sure why,
and
it's something "special" with how caller and package DB interact.

Reduced the test case a bit more​:

Test case 1​: Bizarre copy of ARRAY

#!/usr/bin/perl

my $args = [ "AAA" ];
sub s1 {
  my ($args2) = @​_;

  $args = [ "BBB" ];
  my $h = {};
  my $z = sub { $h };
  s2();
}

sub s2 {
  package DB;
  my (@​foo) = caller(1);
  print "ARG​: $DB​::args[0]\n";
  foreach(@​DB​::args) {
  my $c = $_;
  }
}

s1(@​$args);
__END__

Expected output​: 'ARG​: AAA'

$ miniperl-5.000 rt-52610.pl
ARG​: AAA

$ miniperl-5.001 rt-52610.pl
ARG​:

$ miniperl-perl-5.001n rt-52610.pl
ARG​:

$ miniperl-5.002beta1 rt-52610.pl
ARG​:
Bizarre copy of ARRAY in scalar assignment at rt-52610.pl line 18.

$ perl-5.8.8 rt-52610.pl
ARG​:
Bizarre copy of ARRAY in sassign at rt-52610.pl line 18.

=> perl-5.000 outputs 'ARG​: AAA' because closures were not yet
implemented. This means that the $arg_hash->{args} in sub s1 is another
scalar.
=> If the test is repeated with global variables then perl-5.000 also
outputs 'ARG​: '

Test case 2​: copy $args before changing it

#!/usr/bin/perl

my $args = [ "AAA" ];
sub s1 {
  my ($args2) = @​_;

  my $t = $args;
  $args = [ "BBB" ];
  my $h = {};
  my $z = sub { $h };
  s2();
}

sub s2 {
  package DB;
  my (@​foo) = caller(1);
  print "ARG​: $DB​::args[0]\n";
  foreach(@​DB​::args) {
  my $c = $_;
  }
}

s1(@​$args);

__END__

$ perl-5.8.8 rt-52610.pl
ARG​: AAA

Test case 3​: Remove $h and $z

#!/usr/bin/perl

my $args = [ "AAA" ];
sub s1 {
  my ($args2) = @​_;

  $args = [ "CCC" ];
  s2();
}

sub s2 {
  package DB;
  my (@​foo) = caller(1);
  print "ARG​: $DB​::args[0]\n";
  foreach(@​DB​::args) {
  my $c = $_;
  }
}

s1(@​$args);
__END__

$ perl-5.8.0 rt-52610.pl
ARG​:
Segmentation fault

$ perl-5.8.1 rt-52610.pl
ARG​:
Use of freed value in iteration at rt-52610.pl line 15.

$ perl-5.8.8 rt-52610.pl
ARG​:
Use of freed value in iteration at rt-52610.pl line 15.

Test case 4​: use three hashes instead of a hash and a subroutine

#!/usr/bin/perl

my $args = [ "AAA" ];
sub s1 {
  my ($args2) = @​_;

  $args = [ "BBB" ];

  my $h = {};
  my $h2 = {};
  my $h3 = {};

  s2();
}

sub s2 {
  package DB;
  my (@​foo) = caller(1);
  print "ARG​: $DB​::args[0]\n";
  foreach(@​DB​::args) {
  my $c = $_;
  }
}

s1(@​$args);
__END__

$ perl-5.8.8 rt-52610.pl
ARG​:
Bizarre copy of HASH in sassign at rt-52610.pl line 21.

Test case 5​: Use​: @​foo2 = @​DB​::args

#!/usr/bin/perl

my $args = [ "AAA" ];
sub s1 {
  my ($args2) = @​_;

  $args = [ "BBB" ];
  s2();
}

sub s2 {
  package DB;
  my (@​foo) = caller(1);
  print "ARG​: $DB​::args[0]\n";
  my @​foo2 = @​DB​::args;
}

s1(@​$args);
__END__

$ perl-5.8.6 rt-52610.pl
ARG​:
Segmentation fault

$ perl-5.8.7 rt-52610.pl
ARG​:
semi-panic​: attempt to dup freed string at rt-52610.pl line 15.

$ perl-5.8.8 rt-52610.pl
ARG​:
semi-panic​: attempt to dup freed string at rt-52610.pl line 15.

Kind regards,

Bram

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Feb 14, 2009

From p5p@spam.wizbit.be

Another test case​:

#!/usr/bin/perl

my @​args = 1 .. 10;
sub s1 {
  @​args = "aaa";
  my $h = {};
  s2();
}

sub s2 {
  package DB;
  my @​foo = caller(1);
  foreach (@​DB​::args) { print $_; }
}
s1(@​args);
__END__

$ perl-5.8.8 rt-52610.pl
aaa
Bizarre copy of HASH in print at rt-52610.pl line 13.

What happens is that the array is placed on the stack, then sub s1 is
called and changes the original array. The stack isn't ref counted so
the original array is freed.

Then caller() access the stack and (I assume!) stores/aliasses all
elements in @​DB​::args. This causes already free'ed elements to appear
in @​DB​::args which obviously creates problems...

Kind regards,

Bram

1 similar comment
@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Feb 14, 2009

From p5p@spam.wizbit.be

Another test case​:

#!/usr/bin/perl

my @​args = 1 .. 10;
sub s1 {
  @​args = "aaa";
  my $h = {};
  s2();
}

sub s2 {
  package DB;
  my @​foo = caller(1);
  foreach (@​DB​::args) { print $_; }
}
s1(@​args);
__END__

$ perl-5.8.8 rt-52610.pl
aaa
Bizarre copy of HASH in print at rt-52610.pl line 13.

What happens is that the array is placed on the stack, then sub s1 is
called and changes the original array. The stack isn't ref counted so
the original array is freed.

Then caller() access the stack and (I assume!) stores/aliasses all
elements in @​DB​::args. This causes already free'ed elements to appear
in @​DB​::args which obviously creates problems...

Kind regards,

Bram

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Feb 14, 2009

From p5p@spam.wizbit.be

One more thought​: caller and @​DB​::args aren't really nessesary to show
the bug.

#!/usr/bin/perl -l

my @​args = 1 .. 10;
sub s1 {
  @​args = "AA";
  my $h = {};
  print for @​_;
}
s1(@​args);
__END__
AA
Bizarre copy of HASH in print at rt-52610.pl line 7.

If nothing in sub s1() access @​_ then this is a 'silent' bug.
That is, until something starts going back in the stack and starts
looking at the arguments that are passed.

The real fix is to make the stack do ref counting..
But since I don't expect this to happen soon another 'solution' could
be to add some documentation about this in Carp and add a configuration
option in $Carp which determines if it looks at @​DB​::args or not. That
way at least the name of the offending subroutine can be found.

This information would be more useful and allows for the problem to be
'fixed' (as in, altering the code so it does not modify the stack).

Any thoughts?

Kind regards,

Bram

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Mar 12, 2010

From nadim@khemir.net

Can also generate these error message​:

Bizarre copy of ARRAY in sassign at
/usr/lib64/perl5/5.10.1/Carp/Heavy.pm line 104.

panic​: attempt to copy freed scalar 1ad5ac0 to 1ccee98 at
/usr/lib64/perl5/5.10.1/Carp/Heavy.pm line 104

Bizarre copy of HASH in sassign at
/usr/lib64/perl5/5.10.1/Carp/Heavy.pm line 104

as reported in https://rt.cpan.org/Ticket/Display.html?id=55179

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 14, 2010

From rabbit@thesaurus

Created by rabbit@thesaurus.(none)

I finally managed to reroduce the Test​:: related failures that
have been plaguing some of my modules. I ended up being more
"successful" than I originaly hoped for. Attached is a standalone
program (read the header for explanation why the perl looks like
written by a 4yo), and the logs generated by​:

for pv in $(perlbrew installed | grep '^5') ; do perlbrew switch $pv ; perl perlfail.t &> $pv.log ; done

Cheers!

Perl Info

Flags:
    category=core
    severity=medium

Site configuration information for perl 5.12.1:

Configured by rabbit at Mon Jul  5 14:25:50 CEST 2010.

Summary of my perl5 (revision 5 version 12 subversion 1) configuration:
   
  Platform:
    osname=linux, osvers=2.6.29.2.thes2, archname=i686-linux-thread-multi
    uname='linux thesaurus 2.6.29.2.thes2 #1 preempt tue sep 8 11:27:43 cest 2009 i686 gnulinux '
    config_args='-de -Dprefix=/home/rabbit/perl5/perlbrew/perls/5.12.1 -Dusethreads'
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=define, usemultiplicity=define
    useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
    use64bitint=undef, use64bitall=undef, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O2',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include'
    ccversion='', gccversion='4.4.4', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=4, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -fstack-protector -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib /usr/lib64
    libs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
    perllibs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
    libc=/lib/libc-2.11.1.so, so=so, useshrplib=false, libperl=libperl.a
    gnulibc_version='2.11.1'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
    cccdlflags='-fPIC', lddlflags='-shared -O2 -L/usr/local/lib -fstack-protector'

Locally applied patches:
    


@INC for perl 5.12.1:
    /home/rabbit/devel/utils/perl
    /home/rabbit/devel/utils/perl
    /home/rabbit/perl5/perlbrew/perls/5.12.1/lib/site_perl/5.12.1/i686-linux-thread-multi
    /home/rabbit/perl5/perlbrew/perls/5.12.1/lib/site_perl/5.12.1
    /home/rabbit/perl5/perlbrew/perls/5.12.1/lib/5.12.1/i686-linux-thread-multi
    /home/rabbit/perl5/perlbrew/perls/5.12.1/lib/5.12.1
    .


Environment for perl 5.12.1:
    HOME=/home/rabbit
    LANG=en_US.UTF-8
    LANGUAGE (unset)
    LC_ADDRESS=en_US.UTF-8
    LC_COLLATE=en_US.UTF-8
    LC_CTYPE=en_US.UTF-8
    LC_IDENTIFICATION=en_US.UTF-8
    LC_MESSAGES=en_US.UTF-8
    LC_MONETARY=en_US.UTF-8
    LC_NAME=en_US.UTF-8
    LC_NUMERIC=en_US.UTF-8
    LC_TELEPHONE=en_US.UTF-8
    LC_TIME=en_US.UTF-8
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/home/rabbit/devel/utils:/home/rabbit/perl5/perlbrew/bin:/home/rabbit/perl5/perlbrew/perls/current/bin:/home/rabbit/devel/utils:/home/rabbit/perl5/perlbrew/bin:/home/rabbit/perl5/perlbrew/perls/current/bin:/home/rabbit/bin:/usr/local/bin:/usr/bin:/bin:/usr/bin/X11:/usr/games
    PERL5LIB=/home/rabbit/devel/utils/perl:/home/rabbit/devel/utils/perl:
    PERL_AUTOINSTALL_PREFER_CPAN=1
    PERL_BADLANG (unset)
    SHELL=/bin/bash

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 14, 2010

From @ribasushi

Test and logs

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 14, 2010

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 14, 2010

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 14, 2010

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 14, 2010

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 14, 2010

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 14, 2010

From @ribasushi

#!/usr/bin/perl

###############################################################
#
# !!!!!!!!!!!!!!!!! NOTE !!!!!!!!!!!!!!!!!
#
# The seemingly chaotic code seen below is a result of blind
# trial-and-error reduction of a valid but failing cpan
# module test. The weirdest part is that if I rewrite parts
# of the source, while keeping the semantics, the failures
# change, or go away entirely
#

use strict;
use warnings;

{
  package Tst​::Croaker;

  use Carp;

  sub diaf { shift->d ('Croaking croaker croaked') }
  sub d {
  my($func) = (caller(1))[3];
  croak "$func​:", @​_;
  }

  sub wiaf { shift->w ( 'Carping carper carped') }
  sub w {
  my($func) = (caller(1))[3];
  carp "$func​:", @​_;
  }
}

use Test​::More qw/no_plan/;
use Test​::Warn;
use Test​::Exception;

my $max = 8;

for (1 .. $max) {
  my $new = { debug => $ENV{DEBUG} || 0 };

  # test without quoting labels
  {
  my $s = bless ({}, 'Tst​::Croaker');

  warning_like (
  sub { $s->wiaf ($_) },
  qr/carped/,
  "throws the expected warning"
  );
  }
}

for (1 .. $max) {
  {
  my $x = sub { Tst​::Croaker->diaf };
  throws_ok (sub { $x->() }, qr/croaked/, "try $_");
  }
}

# Just for debugging purposes, removing it doesn't
# seem to fix things (but changes the output again)

END {
  no warnings qw/once/;
  require Data​::Dumper;
  $Data​::Dumper​::Sortkeys = 1;
  warn Data​::Dumper​::Dumper ({
  perl_ver => $],
  threads => eval { require threads; 'Yes'; } || 'No',
  inc => { map
  {
  if (my ($m) = $_ =~ /(.+)\.pm$/) {
  $m =~ s/\//​::/g;
  ($m => $m->VERSION || 'N/A')
  }
  else {
  ($_ => $INC{$_})
  }
  }
  (keys %INC)
  },
  });
}

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 14, 2010

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 14, 2010

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 14, 2010

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 14, 2010

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 14, 2010

From @ribasushi

More fail. I aplogize for the duplication, didn't realize there was an
open bug about the issue, as glancing over "Bizarre" search results
showed all as closed (plus folks on #p5p assured me most of the
"bizarre" errors are fixed).

http​://rt.perl.org/rt3/Ticket/Display.html?id=76496

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 14, 2010

From @ribasushi

And of course it turns out bug is real and reported for quite some time.
Treat this one as redundant

http​://rt.perl.org/rt3/Ticket/Display.html?id=52610

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 14, 2010

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

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 16, 2010

From @ribasushi

On Tue Jul 13 20​:10​:42 2010, ribasushi wrote​:

And of course it turns out bug is real and reported for quite some time.
Treat this one as redundant

http​://rt.perl.org/rt3/Ticket/Display.html?id=52610

Hmmm... after reading the explanations on all previous tickets, I
actually think what I am seeing is a related, but different issue.
Consider my next test program - it does *not* modify @​_ in any way, in
fact it doesn't even access it for reading. Also note it no longer fails
under 5.8.9 (my previous attempt did, even though I again was not
fiddling with @​). I guess either Test​::Exception and/or Test​::Warn do
something to trigger this bug without user help...

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 16, 2010

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 16, 2010

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 16, 2010

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 16, 2010

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 16, 2010

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 16, 2010

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 16, 2010

From @ribasushi

#!/usr/bin/perl

use strict;
use warnings;

{
  package Tst​::Croaker;

  use Carp;

  sub diaf { croak ('Croaking croaker croaked') }
  sub wiaf { carp ( 'Carping carper carped') }
}

use Test​::More qw/no_plan/;
use Test​::Warn;
use Test​::Exception;

for my $x (1 .. 5) {
  warning_like (
  sub { Tst​::Croaker->wiaf ($x) }, # <--- note, wiaf() does *not* touch @​_
  qr/carped/,
  "throws the expected warning"
  );
}

throws_ok (sub { Tst​::Croaker->diaf }, qr/croaked/, "throws exception");

# Just for log-tagging purposes, removing it doesn't
# change anything

END {
  no warnings qw/once/;
  require Data​::Dumper;
  $Data​::Dumper​::Sortkeys = 1;
  warn Data​::Dumper​::Dumper ({
  perl_ver => $],
  threads => eval { require threads; 'Yes'; } || 'No',
  inc => { map
  {
  if (my ($m) = $_ =~ /(.+)\.pm$/) {
  $m =~ s/\//​::/g;
  ($m => $m->VERSION || 'N/A')
  }
  else {
  ($_ => $INC{$_})
  }
  }
  (keys %INC)
  },
  });
}

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 16, 2010

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 16, 2010

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 16, 2010

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 17, 2010

From @nwc10

On Fri, Jul 16, 2010 at 12​:32​:02AM -0700, rabbit+bugs@​rabbit.us via RT wrote​:

On Tue Jul 13 20​:10​:42 2010, ribasushi wrote​:

And of course it turns out bug is real and reported for quite some time.
Treat this one as redundant

http​://rt.perl.org/rt3/Ticket/Display.html?id=52610

Hmmm... after reading the explanations on all previous tickets, I
actually think what I am seeing is a related, but different issue.
Consider my next test program - it does *not* modify @​_ in any way, in
fact it doesn't even access it for reading. Also note it no longer fails
under 5.8.9 (my previous attempt did, even though I again was not
fiddling with @​). I guess either Test​::Exception and/or Test​::Warn do
something to trigger this bug without user help...

It's a shame that the tickets were merged (but I would have done it too).

Bug 76496 is actually a bug in Test​::Exception.

Could you report it there, with this patch to fix it​:

Inline Patch
--- lib/Test/Exception.pm~	2010-01-12 06:31:23.000000000 +0000
+++ lib/Test/Exception.pm	2010-07-17 11:41:50.000000000 +0100
@@ -85,11 +85,23 @@
 sub _quiet_caller (;$) { ## no critic Prototypes
     my $height = $_[0];
     $height++;
-    if( wantarray and !@_ ) {
-        return (CORE::caller($height))[0..2];
+    if ( CORE::caller() eq 'DB' ) {
+        # passthrough the @DB::args trick
+        package DB;
+        if( wantarray and !@_ ) {
+            return (CORE::caller($height))[0..2];
+        }
+        else {
+            return CORE::caller($height);
+        }
     }
     else {
-        return CORE::caller($height);
+        if( wantarray and !@_ ) {
+            return (CORE::caller($height))[0..2];
+        }
+        else {
+            return CORE::caller($height);
+        }
     }
 }
 


The problem is that it overrides caller, but doesn't override *all* of caller. Hence when Carp using caller from package DB\, Carp expects @​DB​::args to have been updated\. Sub​::Uplevel \*does\* do this \(where I pinched the code from\) but it doesn't\.

Result - @​DB​::args is stale - it's referring to the state of @​_ from some
previous time. In this case, it's the address of the now freed temporary $x
used in the call to waif()​:

  for $x (1 .. 1) {
  sub { Tst​::Croaker->wiaf ($x) }->()
  }
 
  throws_ok (sub { Tst​::Croaker->diaf }, qr/croaked/, "throws exception");

[which has been subsequently re-used for the string "Regexp" inside qr//, and
now is in use for the AV used to linearise @​Regexp​::ISA]

I suspect that the core docs for caller need to be updated to warn that if you
override caller via CORE​::GLOBAL​::caller your override *must* implement the
package DB "hack", else you will risk strange and seemingly random breakage
of other code.

I have a feeling of déjà vu here. Did some other module that overrides caller
come unstuck with @​DB​::args in the past year or two?

Nicholas Clark

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 17, 2010

From @xdg

On Sat, Jul 17, 2010 at 6​:51 AM, Nicholas Clark <nick@​ccl4.org> wrote​:

I have a feeling of déją vu here. Did some other module that overrides caller
come unstuck with @​DB​::args in the past year or two?

Sub​::Uplevel implemented support for DB about two years ago.

-- David

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 17, 2010

From @ribasushi

On Sat Jul 17 03​:51​:32 2010, nicholas wrote​:

It's a shame that the tickets were merged (but I would have done it
too).

Bug 76496 is actually a bug in Test​::Exception.

Could you report it there, with this patch to fix it​:

The problem is that it overrides caller, but doesn't override *all* of
caller.
Hence when Carp using caller from package DB, Carp expects @​DB​::args
to have
been updated. Sub​::Uplevel *does* do this (where I pinched the code
from)
but it doesn't.

Result - @​DB​::args is stale - it's referring to the state of @​_ from
some
previous time. In this case, it's the address of the now freed
temporary $x
used in the call to waif()​:

for $x \(1 \.\. 1\) \{
    sub \{ Tst&#8203;::Croaker\->wiaf \($x\) \}\->\(\)
\}

throws\_ok \(sub \{ Tst&#8203;::Croaker\->diaf \}\, qr/croaked/\, "throws

exception");

[which has been subsequently re-used for the string "Regexp" inside
qr//, and
now is in use for the AV used to linearise @​Regexp​::ISA]

I suspect that the core docs for caller need to be updated to warn
that if you
override caller via CORE​::GLOBAL​::caller your override *must*
implement the
package DB "hack", else you will risk strange and seemingly random
breakage
of other code.

Nicholas++

Bug reported https://rt.cpan.org/Ticket/Display.html?id=55179#txn-805481

I also looked at Test​::Warn but it looks *much* simpler and does nto
really mess with caller() in any way. Not sure if this is a bug or a
feature (have to admit I don't understand T​::E much :(

Thank you all!

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 12, 2010

From @ribasushi

On Sat Jul 17 03​:51​:32 2010, nicholas wrote​:

On Fri, Jul 16, 2010 at 12​:32​:02AM -0700, rabbit+bugs@​rabbit.us via RT
wrote​:

On Tue Jul 13 20​:10​:42 2010, ribasushi wrote​:

And of course it turns out bug is real and reported for quite some
time.
Treat this one as redundant

http​://rt.perl.org/rt3/Ticket/Display.html?id=52610

Hmmm... after reading the explanations on all previous tickets, I
actually think what I am seeing is a related, but different issue.
Consider my next test program - it does *not* modify @​_ in any way,
in
fact it doesn't even access it for reading. Also note it no longer
fails
under 5.8.9 (my previous attempt did, even though I again was not
fiddling with @​). I guess either Test​::Exception and/or Test​::Warn
do
something to trigger this bug without user help...

It's a shame that the tickets were merged (but I would have done it
too).

Bug 76496 is actually a bug in Test​::Exception.

Just for completeness sake I'm announcing that the latest
Test​::Exception 0.31 is finally free of @​DB​::args corruption. Perl still
needs fixing of course, but we should see less of this problem in the
wild now.

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jan 30, 2011

From @autarch

This no longer manifests in the same way. The attached code now ends up
(incorrectly) triggering the "** Incomplete caller override detected;
@​DB​::args were not set **" warning from Carp.

This is somewhat of an improvement, perhaps.

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented May 1, 2012

From douglasg.wilson@gmail.com

On Tue Apr 15 02​:53​:34 2008, nicholas wrote​:

On Tue, Apr 08, 2008 at 11​:39​:25AM -0700, Chris Heath wrote​:

use Carp;

Please, please can we get Carp patched with​:

@​args = map {
  local $@​;
  my $tmp = eval { Carp​::format_arg($_) };
  defined($tmp) ? $tmp : 'unknown'; # or 'freed', I don't care
} @​DB​::args;

Then at least Carp will report useful errors. Carp should be
bulletproof. A proper stack backtrace, even with an 'unknown' argument,
is infinitely better than getting the 'Bizarre copy' error in the real
world. You can fix '@​DB​::args' when you get a round tuit.

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

Successfully merging a pull request may close this issue.

None yet
1 participant
You can’t perform that action at this time.