SEGV when next is followed by a goto to a label in the same block #7897

p5pRT · 2005-05-04T10:37:42Z

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

Searchable as RT35214$

p5pRT · 2005-05-04T10:37:43Z

From bod@debian.org

Created by bod@debian.org

Segfault in the following code:

#!/usr/bin/perl

for ($_ = 1; $_ < 3; $_++)
{
AGAIN:
if ($_ == 1) { next }
if ($_ == 2) { $_ = 3; goto AGAIN }
}
__END__

Backtrace:

#0 0x0014f48c in Perl_pp_leaveloop (my_perl=0x1fbfc0) at pp_ctl.c:1768
1768 *++newsp = sv_mortalcopy(*SP);
(gdb) bt
#0 0x0014f48c in Perl_pp_leaveloop (my_perl=0x1fbfc0) at pp_ctl.c:1768
#1 0x000bd1c8 in Perl_runops_debug (my_perl=0x1fbfc0) at dump.c:1442
#2 0x0002e9ac in S_run_body (my_perl=0x1fbfc0, oldscope=1) at perl.c:1921
#3 0x0002e218 in perl_run (my_perl=0x1fbfc0) at perl.c:1840
#4 0x000275e8 in main (argc=2, argv=0xeffff084, env=0xeffff090) at perlmain.c:86
(gdb)

The problem only occurs when both the next and the goto are executed,
and in the order given (next followed by goto).

Perl Info


Flags:
    category=core
    severity=low

Site configuration information for perl v5.8.4:

Configured by Debian Project at Tue Mar  8 20:30:23 EST 2005.

Summary of my perl5 (revision 5 version 8 subversion 4) configuration:
  Platform:
    osname=linux, osvers=2.4.27, archname=sparc-linux-thread-multi
    uname='linux londo 2.4.27 #1 sun sep 19 18:17:57 est 2004 sparc64 gnulinux '
    config_args='-Dusethreads -Duselargefiles -Dccflags=-DDEBIAN -Dcccdlflags=-fPIC -Darchname=sparc-linux -Dprefix=/usr -Dprivlib=/usr/share/perl/5.8 -Darchlib=/usr/lib/perl/5.8 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/perl5 -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.8.4 -Dsitearch=/usr/local/lib/perl/5.8.4 -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 -Uusesfio -Uusenm -Duseshrplib -Dlibperl=libperl.so.5.8.4 -Dd_dosuid -des'
    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='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBIAN -fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O2',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBIAN -fno-strict-aliasing -I/usr/local/include'
    ccversion='', gccversion='3.3.5 (Debian 1:3.3.5-9)', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=4321
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=8
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib
    libs=-lgdbm -lgdbm_compat -ldb -ldl -lm -lpthread -lc -lcrypt
    perllibs=-ldl -lm -lpthread -lc -lcrypt
    libc=/lib/libc-2.3.2.so, so=so, useshrplib=true, libperl=libperl.so.5.8.4
    gnulibc_version='2.3.2'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
    cccdlflags='-fPIC -fPIC', lddlflags='-shared -L/usr/local/lib'

Locally applied patches:
    


@INC for perl v5.8.4:
    /etc/perl
    /usr/local/lib/perl/5.8.4
    /usr/local/share/perl/5.8.4
    /usr/lib/perl5
    /usr/share/perl5
    /usr/lib/perl/5.8
    /usr/share/perl/5.8
    /usr/local/lib/site_perl
    .


Environment for perl v5.8.4:
    HOME=/home/bod
    LANG=en_AU
    LANGUAGE (unset)
    LC_COLLATE=C
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/home/bod/bin:/usr/local/bin:/usr/bin:/bin:/usr/bin/X11:/usr/games:
    PERL_BADLANG (unset)
    SHELL=/usr/bin/ksh

p5pRT · 2005-05-04T14:29:15Z

From @iabyn

On Wed, May 04, 2005 at 10:37:43AM -0000, Brendan O'Dea wrote:

Segfault in the following code:

#!/usr/bin/perl

for ($_ = 1; $_ < 3; $_++)
{
AGAIN:
if ($_ == 1) { next }
if ($_ == 2) { $_ = 3; goto AGAIN }
}

Fixed by the change below. next (and redo) didn't retore the old
PL_curcop, so on next loop entry, the oldcop stored in the context block
was the wrong one, which then confused goto.

This is demonstrated by the following code

#!/usr/bin/perl -w
for ($_=1; (($_ == 2 && die), $_<3); $_++) {
next if $_ == 1;
}

$ perl592 /tmp/p
Died at /tmp/p line 3.
$ ./fixedperl /tmp/p
Died at /tmp/p line 2.
$

Dave

--
The Enterprise is captured by a vastly superior alien intelligence which
does not put them on trial.
-- Things That Never Happen in "Star Trek" #10

Change 24384 by davem@davem-splatty on 2005/05/04 14:01:40

[perl #35214] SEGV when next is followed by a goto

next and redo didn't restore PL_curcop

Affected files ...

... //depot/perl/pp_ctl.c#427 edit
... //depot/perl/t/op/goto.t#26 edit

Differences ...

==== //depot/perl/pp_ctl.c#427 (text) ====

@@ -1890,6 +1890,7 @@
SV **mark;

POPBLOCK(cx,newpm);
+ assert(CxTYPE(cx) == CXt_LOOP);
mark = newsp;
newsp = PL_stack_base + cx->blk_loop.resetsp;

@@ -2149,6 +2150,7 @@
TOPBLOCK(cx);
if (PL_scopestack_ix < inner)
leave_scope(PL_scopestack[PL_scopestack_ix]);
+ PL_curcop = cx->blk_oldcop;
return cx->blk_loop.next_op;
}

@@ -2176,6 +2178,7 @@
oldsave = PL_scopestack[PL_scopestack_ix - 1];
LEAVE_SCOPE(oldsave);
FREETMPS;
+ PL_curcop = cx->blk_oldcop;
return cx->blk_loop.redo_op;
}

==== //depot/perl/t/op/goto.t#26 (xtext) ====

@@ -7,7 +7,7 @@
@INC = qw(. ../lib);
}

-print "1..47\n";
+print "1..49\n";

require "test.pl";

@@ -414,5 +414,27 @@
sub c32039 { print $_[0] eq 'foo' ? "" : "not ", "ok 47 - chained &goto\n" }
a32039();

+# [perl #35214] next and redo re-entered the loop with the wrong cop,
+# causing a subsequent goto to crash
+
+{
+ my $r = runperl(
+ stderr => 1,
+ prog =>
+'for ($_=0;$_<3;$_++){A: if($_==1){next} if($_==2){$_++;goto A}}print qq(ok)'
+ );
+ $r =~ s/\n//g;
+ print "# r=$r\nnot " unless $r eq 'ok';
+ print "ok 48 - next and goto\n";
+
+ $r = runperl(
+ stderr => 1,
+ prog =>
+'for ($_=0;$_<3;$_++){A: if($_==1){$_++;redo} if($_==2){$_++;goto A}}print qq(ok)'
+ );
+ $r =~ s/\n//g;
+ print "# r=$r\nnot " unless $r eq 'ok';
+ print "ok 49 - redo and goto\n";
+}

p5pRT · 2005-05-04T14:29:17Z

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

p5pRT · 2005-05-04T14:31:46Z

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

p5pRT · 2005-05-04T15:40:41Z

From @smpeters

On Wed, May 04, 2005 at 03:28:47PM +0100, Dave Mitchell wrote:

On Wed, May 04, 2005 at 10:37:43AM -0000, Brendan O'Dea wrote:

Segfault in the following code:

#!/usr/bin/perl

for ($_ = 1; $_ < 3; $_++)
{
AGAIN:
if ($_ == 1) { next }
if ($_ == 2) { $_ = 3; goto AGAIN }
}

Fixed by the change below. next (and redo) didn't retore the old
PL_curcop, so on next loop entry, the oldcop stored in the context block
was the wrong one, which then confused goto.

This is demonstrated by the following code
\#\!/usr/bin/perl \-w
for $$\_=1; \(\($\_ == 2 && die$\, $\_\<3\); $\_\+\+\) \{
next if $\_ == 1;
\}
$ perl592 /tmp/p
Died at /tmp/p line 3.
$ ./fixedperl /tmp/p
Died at /tmp/p line 2.
$

I'm guessing this is an unintentional side effect, but this fix also took
care of the long-standing issue of redo's within a for loop that I tried
to get some discussion about last week (RT #2049).

Steve Peters
steve@fisharerojo.org

p5pRT · 2005-05-04T15:46:07Z

From @demerphq

On 5/4/05, Steve Peters <steve@fisharerojo.org> wrote:

On Wed, May 04, 2005 at 03:28:47PM +0100, Dave Mitchell wrote:
On Wed, May 04, 2005 at 10:37:43AM -0000, Brendan O'Dea wrote:

Segfault in the following code:

#!/usr/bin/perl

for ($_ = 1; $_ < 3; $_++)
{
AGAIN:
if ($_ == 1) { next }
if ($_ == 2) { $_ = 3; goto AGAIN }
}

Fixed by the change below. next (and redo) didn't retore the old
PL_curcop, so on next loop entry, the oldcop stored in the context block
was the wrong one, which then confused goto.

This is demonstrated by the following code
\#\!/usr/bin/perl \-w
for $$\_=1; \(\($\_ == 2 && die$\, $\_\<3\); $\_\+\+\) \{
  next if $\_ == 1;
\}
$ perl592 /tmp/p
Died at /tmp/p line 3.
$ ./fixedperl /tmp/p
Died at /tmp/p line 2.
$
I'm guessing this is an unintentional side effect, but this fix also took
care of the long-standing issue of redo's within a for loop that I tried
to get some discussion about last week (RT #2049).

And there was rejoicing in the streets!

:-)

Yves

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

p5pRT · 2005-05-04T15:53:52Z

From @smpeters

On Wed, May 04, 2005 at 10:39:59AM -0500, Steve Peters wrote:

On Wed, May 04, 2005 at 03:28:47PM +0100, Dave Mitchell wrote:
On Wed, May 04, 2005 at 10:37:43AM -0000, Brendan O'Dea wrote:

Segfault in the following code:

#!/usr/bin/perl

for ($_ = 1; $_ < 3; $_++)
{
AGAIN:
if ($_ == 1) { next }
if ($_ == 2) { $_ = 3; goto AGAIN }
}

Fixed by the change below. next (and redo) didn't retore the old
PL_curcop, so on next loop entry, the oldcop stored in the context block
was the wrong one, which then confused goto.

This is demonstrated by the following code
\#\!/usr/bin/perl \-w
for $$\_=1; \(\($\_ == 2 && die$\, $\_\<3\); $\_\+\+\) \{
next if $\_ == 1;
\}
$ perl592 /tmp/p
Died at /tmp/p line 3.
$ ./fixedperl /tmp/p
Died at /tmp/p line 2.
$
I'm guessing this is an unintentional side effect, but this fix also took
care of the long-standing issue of redo's within a for loop that I tried
to get some discussion about last week (RT #2049).

Ignore my previous message. This fix did nothing for RT #2049.

Steve Peters
steve@fisharerojo.org

p5pRT closed this as completed May 4, 2005

p5pRT added Severity Low distro-Linux type-core labels Oct 18, 2019

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

SEGV when next is followed by a goto to a label in the same block #7897

SEGV when next is followed by a goto to a label in the same block #7897

p5pRT commented May 4, 2005

p5pRT commented May 4, 2005

p5pRT commented May 4, 2005

p5pRT commented May 4, 2005

p5pRT commented May 4, 2005

p5pRT commented May 4, 2005

p5pRT commented May 4, 2005

p5pRT commented May 4, 2005

SEGV when next is followed by a goto to a label in the same block #7897

SEGV when next is followed by a goto to a label in the same block #7897

Comments

p5pRT commented May 4, 2005

p5pRT commented May 4, 2005

From bod@debian.org

Created by bod@debian.org

p5pRT commented May 4, 2005

From @iabyn

p5pRT commented May 4, 2005

p5pRT commented May 4, 2005

p5pRT commented May 4, 2005

From @smpeters

p5pRT commented May 4, 2005

From @demerphq

p5pRT commented May 4, 2005

From @smpeters