From dan@gina.alaska.edu

Created by dan@gina.alaska.edu

The following program causes a segmentation fault​:

#!/usr/bin/perl

use strict;
use warnings;

my $x;
#my $x = []; # also crashes

push @​$x, abc();

sub abc {
  $x = 1;
  #$x = []; # also crashes
  return 2;
  #return $x = 1; # also crashes
  # absense of return statement prevents crash
}

#####

$ gdb --args perl crash.pl
Program received signal SIGSEGV, Segmentation fault.
0x00007ffff7d091a8 in Perl_av_store (my_perl=0x602010, av=0x606e88, key=6319745, val=0x6070b0) at av.c​:336
336 ary[++AvFILLp(av)] = &PL_sv_undef;
(gdb) bt
#0 0x00007ffff7d091a8 in Perl_av_store (my_perl=0x602010, av=0x606e88, key=6319745, val=0x6070b0) at av.c​:336
#1 0x00007ffff7d3f23a in Perl_pp_push (my_perl=0x602010) at pp.c​:4454
#2 0x00007ffff7cead38 in Perl_runops_debug (my_perl=0x602010) at dump.c​:1931
#3 0x00007ffff7d114f8 in S_run_body (oldscope=<value optimized out>, my_perl=<value optimized out>) at perl.c​:2391
#4 perl_run (oldscope=<value optimized out>, my_perl=<value optimized out>) at perl.c​:2309
#5 0x0000000000400cfc in main (argc=2, argv=0x7fffffffe018, env=0x7fffffffe030) at perlmain.c​:113

I am using Fedora 11.

Flags:
    category=core
    severity=medium

This perlbug was built using Perl 5.10.0 in the Fedora build system.
It is being executed now by Perl 5.10.0 - Fri Apr 10 06:34:03 EDT 2009.

Site configuration information for perl 5.10.0:

Configured by Red Hat, Inc. at Fri Apr 10 06:34:03 EDT 2009.

Summary of my perl5 (revision 5 version 10 subversion 0) configuration:
  Platform:
    osname=linux, osvers=2.6.18-128.1.6.el5, archname=x86_64-linux-thread-multi
    uname='linux x86-3.fedora.phx.redhat.com 2.6.18-128.1.6.el5 #1 smp tue mar 24 12:05:57 edt 2009 x86_64 x86_64 x86_64 gnulinux '
    config_args='-des -Doptimize=-O2 -g -pipe -Wall -Wp,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector --param=ssp-buffer-size=4 -m64 -mtune=generic -DPERL_USE_SAFE_PUTENV -Dversion=5.10.0 -Dmyhostname=localhost -Dperladmin=root@localhost -Dcc=gcc -Dcf_by=Red Hat, Inc. -Dprefix=/usr -Dvendorprefix=/usr -Dsiteprefix=/usr/local -Dprivlib=/usr/lib/perl5/5.10.0 -Dsitelib=/usr/local/lib/perl5/site_perl/5.10.0 -Dvendorlib=/usr/lib/perl5/vendor_perl/5.10.0 -Darchlib=/usr/lib64/perl5/5.10.0/x86_64-linux-thread-multi -Dsitearch=/usr/local/lib64/perl5/site_perl/5.10.0/x86_64-linux-thread-multi -Dvendorarch=/usr/lib64/perl5/vendor_perl/5.10.0/x86_64-linux-thread-multi -Dinc_version_list=none -Darchname=x86_64-linux-thread-multi -Dlibpth=/usr/local/lib64 /lib64 /usr/lib64 -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 -Dpag!
 er=/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 -Dscriptdir=/usr/bin -Dotherlibdirs=/usr/lib/perl5/site_perl'
    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='gcc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DDEBUGGING -fno-strict-aliasing -pipe -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 -m64 -mtune=generic -DPERL_USE_SAFE_PUTENV',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -DDEBUGGING -fno-strict-aliasing -pipe -I/usr/local/include -I/usr/include/gdbm'
    ccversion='', gccversion='4.4.0 20090409 (Red Hat 4.4.0-0.32)', 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='gcc', ldflags =''
    libpth=/usr/local/lib64 /lib64 /usr/lib64
    libs=-lresolv -lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lpthread -lc
    perllibs=-lresolv -lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
    libc=, so=so, useshrplib=true, libperl=libperl.so
    gnulibc_version='2.9.90'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E -Wl,-rpath,/usr/lib64/perl5/5.10.0/x86_64-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 -m64 -mtune=generic -DPERL_USE_SAFE_PUTENV'

Locally applied patches:
    


@INC for perl 5.10.0:
    /usr/local/ION/lib/perl
    /usr/local/ION/lib/perl
    /usr/local/lib64/perl5/site_perl/5.10.0/x86_64-linux-thread-multi
    /usr/local/lib/perl5/site_perl/5.10.0
    /usr/lib64/perl5/vendor_perl/5.10.0/x86_64-linux-thread-multi
    /usr/lib/perl5/vendor_perl/5.10.0
    /usr/lib/perl5/vendor_perl
    /usr/lib64/perl5/5.10.0/x86_64-linux-thread-multi
    /usr/lib/perl5/5.10.0
    /usr/lib/perl5/site_perl
    .


Environment for perl 5.10.0:
    HOME=/home/dstahlke
    LANG=C
    LANGUAGE (unset)
    LD_LIBRARY_PATH=/usr/local/lib:/usr/local/jprofiler3/bin/linux-x86:/home/dstahlke/thesis/lib
    LOGDIR (unset)
    PATH=/usr/java/jdk1.6.0_04/bin:/usr/local/bin:/usr/java/jdk1.6.0_04/bin:/usr/local/bin:/usr/lib64/qt-3.3/bin:/usr/kerberos/bin:/usr/lib64/ccache:/usr/local/bin:/bin:/usr/bin:/usr/local/sbin:/usr/sbin:/sbin:/home/dstahlke/bin:/usr/local/Acrobat5/bin:/usr/local/ION/bin:/usr/java/jdk1.5.0_14/bin:/usr/local/jprofiler3/bin:/home/dstahlke/bin:/home/dstahlke/bin:/usr/local/Acrobat5/bin:/usr/local/ION/bin:/usr/java/jdk1.5.0_14/bin:/usr/local/jprofiler3/bin
    PERL5LIB=:/usr/local/ION/lib/perl:/usr/local/ION/lib/perl
    PERL_BADLANG (unset)
    SHELL=/bin/bash

From nj88udd02@sneakemail.com

Hi all,

dan@​gina.alaska.edu (via RT) wrote​:

# New Ticket Created by dan@​gina.alaska.edu
# Please include the string​: [perl #66930]
# in the subject line of all future correspondence about this issue.
# <URL​: http​://rt.perl.org/rt3/Ticket/Display.html?id=66930 >
[...]

The following program causes a segmentation fault​:

#!/usr/bin/perl

use strict;
use warnings;

my $x;
#my $x = []; # also crashes

push @​$x, abc();

sub abc {
$x = 1;
#$x = []; # also crashes
return 2;
#return $x = 1; # also crashes
# absense of return statement prevents crash
}

Confirmed with blead at 3244086.

Cheers,
Steffen

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

From perl@profvince.com

This happens because the array referenced by $x is pushed on the stack,
and then is freed when abc() resets $x. Hence push tries to access a
freed SV. It can be fixed by deciding at compile time to pass the
reference itself and letting push() dereference it, after the
interpreter is done with the argument list.

Note that replacing push by a prototyped sub doesn't segfault :

  sub def (\@​$) { print @​{$_[0]} }
  my $x;
  def @​$x, do { $x = [ 1 ]; 42 };

This will print "1", because the first argument is actually a new
reference to @​$x, so it survives even if $x is changed. On a side note,
I'm unsure whether this is a very nice behaviour : I'd expect the first
pushed reference to be the one I have access to. Think :

  our $global;
  def @​$global, opaque_sub_that_modifies_global_but_you_dont_know_it();

In any case, it's not consistent with push() where you pass the array
its original state (even if currently it crashes).

Vincent.

From @davidnicol

I shrunk the demonstration a little for addition to t/op/list.t.
Maybe push could be made to really have a \@​@​ prototype instead of
whatever it does now? Where that subroutine result winds up getting
pushed to is not the question here, but I think left to right
processing implies it gets pushed to whatever array $x referred to
before calling the subroutine, so making that new reference is needed
because the reference in the argument can't be trusted to still be an
array reference when we get to the pushing part. When push comes to
shove as it were. Take it away, Vincent Pit!

diff --git a/t/op/list.t b/t/op/list.t
index a8fdc18..b678224 100644
--- a/t/op/list.t
+++ b/t/op/list.t
@@ -6,7 +6,7 @@ BEGIN {
 }

 require "test.pl";
-plan( tests => 57 );
+plan( tests => 59 );

 @foo = (1, 2, 3, 4);
 cmp_ok($foo[0], '==', 1, 'first elem');
@@ -161,3 +161,21 @@ cmp_ok(join('',(1,2),3,(4,5)),'eq','12345','list

+{
+ # perl #66930
+ fresh_perl_is (<<'WORKS',"cheese",{},"66930 push segfault null case");
+push @​$x, (sub {
+ $x = 'cheese';
+})->();
+print "$x\n";
+WORKS
+ fresh_perl_is (<<'66930',"cheese",{},"66930 push segfault");
+push @​$x, (sub {
+ $x = 'cheese';
+ 2;
+})->();
+print "$x\n";
+66930
+
+}
+

From @davidnicol

Where that subroutine result winds up getting
pushed to is not the question here, but I think left to right
processing implies it gets pushed to whatever array $x referred to
before calling the subroutine

On the other hand, that subroutine arguments are all aliases and that
all arguments are evaluated before the subroutine is invoked would put
the subroutine result in the later array. Where does the
non-seg-faulting version put it? In the earlier array.

With the \@​@​ prototype it goes in the earlier array too. With the
implied (@​) prototype, the mypush2 routine below puts "shove" in the
after array.

cat 66930_where_does_it_go.pl
@​before=@​after=();
$x="before";
push @​$x, (sub {
  $x = 'after';
})->();
print "PURE PUSH​:\nx​: $x\nbefore​:@​before\nafter​: @​after\n";

sub mypush(\@​@​) { my $ref = shift; push @​$ref, @​_ }
@​before=@​after=();
$x="before";
mypush @​$x, (sub {
  $x = 'after';
})->();
print "MY PUSH​:\nx​: $x\nbefore​:@​before\nafter​: @​after\n";

@​before=@​after=();
$x="before";
mypush @​$x, (sub {
  $x = 'after';
  "shove"
})->();
print "WOULD SEGFAULT​:\nx​: $x\nbefore​:@​before\nafter​: @​after\n";

@​before=@​after=();
$x="before";
$sub_result = (sub { $x = 'after'; "shove" })->();
push @​$x, $sub_result;
print "PERL-SIDE ORDERING​:\nx​: $x\nbefore​:@​before\nafter​: @​after\n";

@​before=@​after=();
$x="before";
$arrayref = $x;
$sub_result = (sub { $x = 'after'; "shove" })->();
push @​$arrayref, $sub_result;
print "PERL-SIDE ORDERING 2​:\nx​: $x\nbefore​:@​before\nafter​: @​after\n";

sub mypush2 { my $ref = shift; push @​$ref, @​_ }
@​before=@​after=();
$x="before";
mypush2 $x, (sub {
  $x = 'after';
  "shove"
})->();
print "MY PUSH NO PROTOTYPE​:\nx​: $x\nbefore​:@​before\nafter​: @​after\n";
__END__

From @davidnicol

Stunningly, unshift doesn't have the segfault problem. Like push that
works, or a \@​... prototype, the array that gets modified is as seen
before rather than after the modification in the subroutine.

I wonder if a note about this edge case of parameter ordering being
another effect of prototyping belongs in perlsub.pod.

pp_push and pp_unshift in pp.c are very similar.

Hmm. 5.10.0 (standard cygwin) segfaults on push but not unshift.

5.8.8 (debian package) segfaults on both.

Current blead on linux allows push, complains and aborts on unshift,
and I have no idea why. The problem is in the returning, not in the
operations. The time of destruction has been deferred for push and the
same deferment needs to be applied to unshift too?

diff --git a/pp.c b/pp.c
index 9cedc3f..9318755 100644
--- a/pp.c
+++ b/pp.c
@@ -4549,6 +4549,7 @@ PP(pp_push)
        }
     }
     else {
+           Perl_warn(aTHX_ "inside push refcount %i", SvREFCNT((SV*) ary));
        PL_delaymagic = DM_DELAY;
        for (++MARK; MARK <= SP; MARK++) {
            SV * const sv = newSV(0);
@@ -4596,17 +4597,23 @@ PP(pp_unshift)
        SPAGAIN;
     }
     else {
+           Perl_warn(aTHX_ "inside unshift refcount %i", SvREFCNT((SV*) ary));
        register I32 i = 0;
        av_unshift(ary, SP - MARK);
+           Perl_warn(aTHX_ "unshifted %i", SP - MARK);
        while (MARK < SP) {
+           Perl_warn(aTHX_ "unshifting %i", SP - MARK);
            SV * const sv = newSVsv(*++MARK);
+           Perl_warn(aTHX_ "unshifting %i", SP - MARK);
            (void)av_store(ary, i++, sv);
+           Perl_warn(aTHX_ "unshifting %i", SP - MARK);
        }
     }
     SP = ORIGMARK;
     if (GIMME_V != G_VOID) {
        PUSHi( AvFILL(ary) + 1 );
     }
+           Perl_warn(aTHX_ "returning");
     RETURN;
 }

diff --git a/utils/Makefile b/utils/Makefile

This is perl, v5.11.0 (GitLive-blead-g7f6de3f*) built for i686-linux
...

perlhacker@​catnip​:~/perl$ ./perl -le '$x=[]; push @​$x, (sub {$x="";"pbth"})->()'
inside push refcount 1 at -e line 1.
perlhacker@​catnip​:~/perl$ ./perl -le '$x=[]; unshift @​$x, (sub
{$x="";"pbth"})->()'
inside unshift refcount 1 at -e line 1.
unshifted 1 at -e line 1.
unshifting 1 at -e line 1.
unshifting 0 at -e line 1.
unshifting 0 at -e line 1.
returning at -e line 1.
*** glibc detected *** free()​: invalid pointer​: 0x0816939c ***
Aborted

From @iabyn

Without looking at this thread in detail (I just haven't got time at the
moment), my general observation is that most of these bugs are due to
the fact that the perl stack isn't refcounted, which is a fairly
fundamental problem with no quick fixes. So the usual advice is just
"don't modify an array while you're iterating over it / using it as a
function arg / etc etc; and maybe well fix this one year".

On Sun, Jun 28, 2009 at 07​:59​:48PM -0500, David Nicol wrote​:

Stunningly, unshift doesn't have the segfault problem. Like push that
works, or a \@​... prototype, the array that gets modified is as seen
before rather than after the modification in the subroutine.

I wonder if a note about this edge case of parameter ordering being
another effect of prototyping belongs in perlsub.pod.

pp_push and pp_unshift in pp.c are very similar.

Hmm. 5.10.0 (standard cygwin) segfaults on push but not unshift.

5.8.8 (debian package) segfaults on both.

Current blead on linux allows push, complains and aborts on unshift,
and I have no idea why. The problem is in the returning, not in the
operations. The time of destruction has been deferred for push and the
same deferment needs to be applied to unshift too?

diff --git a/pp.c b/pp.c
index 9cedc3f..9318755 100644
--- a/pp.c
+++ b/pp.c
@​@​ -4549,6 +4549,7 @​@​ PP(pp_push)
}
}
else {
+ Perl_warn(aTHX_ "inside push refcount %i", SvREFCNT((SV*) ary));
PL_delaymagic = DM_DELAY;
for (++MARK; MARK <= SP; MARK++) {
SV * const sv = newSV(0);
@​@​ -4596,17 +4597,23 @​@​ PP(pp_unshift)
SPAGAIN;
}
else {
+ Perl_warn(aTHX_ "inside unshift refcount %i", SvREFCNT((SV*) ary));
register I32 i = 0;
av_unshift(ary, SP - MARK);
+ Perl_warn(aTHX_ "unshifted %i", SP - MARK);
while (MARK < SP) {
+ Perl_warn(aTHX_ "unshifting %i", SP - MARK);
SV * const sv = newSVsv(*++MARK);
+ Perl_warn(aTHX_ "unshifting %i", SP - MARK);
(void)av_store(ary, i++, sv);
+ Perl_warn(aTHX_ "unshifting %i", SP - MARK);
}
}
SP = ORIGMARK;
if (GIMME_V != G_VOID) {
PUSHi( AvFILL(ary) + 1 );
}
+ Perl_warn(aTHX_ "returning");
RETURN;
}

diff --git a/utils/Makefile b/utils/Makefile

perlhacker@​catnip​:~/perl$ ./perl -v

This is perl, v5.11.0 (GitLive-blead-g7f6de3f*) built for i686-linux
...

perlhacker@​catnip​:~/perl$ ./perl -le '$x=[]; push @​$x, (sub {$x="";"pbth"})->()'
inside push refcount 1 at -e line 1.
perlhacker@​catnip​:~/perl$ ./perl -le '$x=[]; unshift @​$x, (sub
{$x="";"pbth"})->()'
inside unshift refcount 1 at -e line 1.
unshifted 1 at -e line 1.
unshifting 1 at -e line 1.
unshifting 0 at -e line 1.
unshifting 0 at -e line 1.
returning at -e line 1.
*** glibc detected *** free()​: invalid pointer​: 0x0816939c ***
Aborted

--
The warp engines start playing up a bit, but seem to sort themselves out
after a while without any intervention from boy genius Wesley Crusher.
  -- Things That Never Happen in "Star Trek" #17

From @davidnicol

On Tue, Jun 30, 2009 at 7​:54 AM, Dave Mitchell <davem@​iabyn.com> wrote​:

Without looking at this thread in detail (I just haven't got time at the
moment), my general observation is that most of these bugs are due to
the fact that the perl stack isn't refcounted, which is a fairly
fundamental problem with no quick fixes. So the usual advice is just
"don't modify an array while you're iterating over it / using it as a
function arg / etc etc; and maybe well fix this one year".

While it is true that this bug is clearly of the "so don't do that" variety,
a segfault in any circumstance seems like spilled milk worth wiping up.

While a refcounted stack might prevent freeing the no-longer-referenced
array too early, whatever method is used to call an explicitly prototyped
userland routine manages to escape without segfaulting. That push and
unshift appear to have switched status as to if they segfault or not is
intruiging.

Don't we want to normalize the builtins to use the prototyped calling
conventions? I thought at one point we did; that initiative like so many
others may have fizzled or been rejected due to a slight benchmarked
performance hit.

From @jimc

Don't we want to normalize the builtins to use the prototyped calling
conventions?  I thought at one point we did; that initiative like so many
others may have fizzled or been rejected due to a slight benchmarked
performance hit.

Id suspect that its more like​:

These are problems that are understood, if not by everyone,
then by enough who can say with some authority​: "dont do that".

Im unconvinced that fixing 70% of the bugs I dont understand
will help me at all when I find myself blocked by the other 30%.

Wisdom (self-preservation?) says stay the hell out of the minefield,
It only takes one to go boom, stumpy.

Then theres that "we" in there.
Only the queen gets to use that word.
(and Im as guilty of that as anyone)

From @iabyn

On Thu, Jul 02, 2009 at 07​:22​:45PM -0500, David Nicol wrote​:

While a refcounted stack might prevent freeing the no-longer-referenced
array too early, whatever method is used to call an explicitly prototyped
userland routine manages to escape without segfaulting. That push and
unshift appear to have switched status as to if they segfault or not is
intruiging.

You appear to be conflating "it doesn't segfault" with "there's nothing
wrong". An underlying recount bug may cause some operations to segfault
but not others, and what does and doesn't segfault may vary randomly
between versions.

Anyway, as I said before, I haven't got time to discuss this now.

--
Little fly, thy summer's play my thoughtless hand
has terminated with extreme prejudice.
  (with apologies to William Blake)