local $_ [0] = $_ [0] fails.

[p5pRT]

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

Searchable as RT21542$

[p5pRT]

From @abigail

Created by @abigail

  #!/usr/bin/perl

  sub bar {local $_ [0] = $_ [0];}

  my $str = 'foo';

  bar $str;   bar $str;

  print $str\, "\n";

  __END__

This program just prints a newline. Making small changes to the program can cause segmentation violations. Running this through valgrind gives a segmentation fault​:

  $ /opt/valgrind/bin/valgrind perl bug.pl   ==272== valgrind-20020426\, a memory error detector for x86 GNU/Linux.   ==272== Copyright (C) 2000-2002\, and GNU GPL'd\, by Julian Seward.   ==272== Estimated CPU clock rate is 801 MHz   ==272== For more details\, rerun with​: -v   ==272==   ==272== Invalid read of size 4   ==272== at 0x80FAB0B​: Perl_leave_scope (scope.c​:719)   ==272== by 0x80F8C9D​: Perl_pop_scope (scope.c​:136)   ==272== by 0x80D0731​: Perl_pp_leavesub (pp_hot.c​:2286)   ==272== by 0x80B3583​: Perl_runops_debug (dump.c​:1398)   ==272== Address 0x42114B94 is 0 bytes inside a block of size 16 free'd   ==272== at 0x400400A2​: free (vg_clientfuncs.c​:171)   ==272== by 0x80B3E40​: Perl_safesysfree (util.c​:151)   ==272== by 0x80C6421​: Perl_av_undef (av.c​:457)   ==272== by 0x80DD281​: Perl_sv_clear (sv.c​:5020)   ==272==   ==272== Invalid write of size 4   ==272== at 0x80FAB8A​: Perl_leave_scope (scope.c​:727)   ==272== by 0x80F8C9D​: Perl_pop_scope (scope.c​:136)   ==272== by 0x80D0731​: Perl_pp_leavesub (pp_hot.c​:2286)   ==272== by 0x80B3583​: Perl_runops_debug (dump.c​:1398)   ==272== Address 0x20 is not stack'd\, malloc'd or free'd   Segmentation fault

This problems happens from 5.7.0 onwards\, including in today's blead\, and also in 5.6.1. There is no problem in 5.6.0.

Perl Info

``` Flags: category=core severity=low Site configuration information for perl v5.8.0: Configured by camel at Mon Oct 28 01:28:45 CET 2002. Summary of my perl5 (revision 5.0 version 8 subversion 0) configuration: Platform: osname=linux, osvers=2.4.18-bf2.4, archname=i686-linux-64int-ld uname='linux alexandra 2.4.18-bf2.4 #1 son apr 14 09:53:28 cest 2002 i686 unknown ' config_args='-des -Uversiononly -Dmydomain=.abigail.nl -Dcf_email=camel@abigail.nl -Dperladmin=camel@abigail.nl -Doptimize=-g -Dusemorebits -Dusedevel -Dusenm=false -Dprefix=/opt/perl -Dcc=gcc' hint=recommended, useposix=true, d_sigaction=define usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef useperlio=define d_sfio=undef uselargefiles=define usesocks=undef use64bitint=define use64bitall=undef uselongdouble=define usemymalloc=n, bincompat5005=undef Compiler: cc='gcc', ccflags ='-DDEBUGGING -fno-strict-aliasing -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64', optimize='-g', cppflags='-DDEBUGGING -fno-strict-aliasing' ccversion='', gccversion='3.0.4', gccosandvers='' intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=12345678 d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12 ivtype='long long', ivsize=8, nvtype='long double', nvsize=12, 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=-lnsl -ldl -lm -lc -lcrypt -lutil perllibs=-lnsl -ldl -lm -lc -lcrypt -lutil libc=/lib/libc-2.2.5.so, so=so, useshrplib=false, libperl=libperl.a gnulibc_version='2.2.5' Dynamic Linking: dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-rdynamic' cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib' Locally applied patches: @INC for perl v5.8.0: /home/abigail/Perl /home/abigail/Sybase /opt/perl/lib/5.8.0/i686-linux-64int-ld /opt/perl/lib/5.8.0 /opt/perl/lib/site_perl/5.8.0/i686-linux-64int-ld /opt/perl/lib/site_perl/5.8.0 /opt/perl/lib/site_perl . Environment for perl v5.8.0: HOME=/home/abigail LANG=C LANGUAGE (unset) LD_LIBRARY_PATH=/home/abigail/Lib:/usr/local/lib:/usr/lib:/lib:/usr/X11R6/lib:/opt/gnome/lib LOGDIR (unset) PATH=/home/abigail/Bin:/opt/perl/bin:/usr/local/bin:/usr/local/X11/bin:/usr/bin:/bin:/usr/local/sbin:/usr/sbin:/sbin:/usr/X11R6/bin:/usr/games:/opt/povray/bin:/opt/gnome/bin:/opt/opera/bin:/usr/share/texmf/bin:/opt/Acrobat/bin:/opt/java/blackdown/j2sdk1.3.1/bin:/usr/local/games/bin:/opt/gnuplot/bin:/opt/mysql/bin PERL5LIB=/home/abigail/Perl:/home/abigail/Sybase PERLDIR=/opt/perl PERL_BADLANG (unset) SHELL=/bin/bash ```

[p5pRT]

From @jhi

With blead #18932 I get the following Third Degree trace​:

---------------------------------------------------------------- rih -- 7 -- scope.c​: 723​: reading invalid heap at byte 0 of 32-byte block   Perl_leave_scope libperl.so\, scope.c\, line 723   Perl_pop_scope libperl.so\, scope.c\, line 136   Perl_pp_leavesub libperl.so\, pp_hot.c\, line 2322   Perl_runops_debug libperl.so\, dump.c\, line 1423   S_run_body libperl.so\, perl.c\, line 1582   perl_run libperl.so\, perl.c\, line 1501   main perl\, perlmain.c\, line 85   __start perl

This block at address 0x14001e830 was allocated at​:   malloc libc.so   Perl_safesysmalloc libperl.so\, util.c\, line 69   Perl_av_extend libperl.so\, av.c\, line 150   Perl_pad_tidy libperl.so\, pad.c\, line 1063   Perl_newATTRSUB libperl.so\, op.c\, line 4150   Perl_yyparse libperl.so\, perly.c\, line 1699   S_parse_body libperl.so\, perl.c\, line 1426   perl_parse libperl.so\, perl.c\, line 932   main perl\, perlmain.c\, line 83   __start perl

This block was freed at​:   free libc.so   Perl_safesysfree libperl.so\, util.c\, line 142   Perl_av_undef libperl.so\, av.c\, line 497   Perl_sv_clear libperl.so\, sv.c\, line 5380   Perl_sv_free2 libperl.so\, sv.c\, line 5574   Perl_sv_free libperl.so\, sv.c\, line 5554   Perl_leave_scope libperl.so\, scope.c\, line 972   Perl_pop_scope libperl.so\, scope.c\, line 136   Perl_pp_leavesub libperl.so\, pp_hot.c\, line 2322   Perl_runops_debug libperl.so\, dump.c\, line 1423   S_run_body libperl.so\, perl.c\, line 1582   perl_run libperl.so\, perl.c\, line 1501   main perl\, perlmain.c\, line 85   __start perl

[p5pRT]

From @iabyn

On Tue\, Mar 11\, 2003 at 08​:07​:20PM -0000\, abigail@​abigail.nl (via RT) wrote​:

\#\!/usr/bin/perl

sub bar \{local $\_ \[0\] = $\_ \[0\];\}

my  $str = 'foo';

bar $str;
bar $str;

print $str\, "\\n";

\_\_END\_\_

This program just prints a newline. Making small changes to the program can cause segmentation violations.

It's two related problems to do with the reification (is that a word?) of @​_.

The local() causes a SAVEt_AELEM to be pushed onto the savestack. When the element is retored on scope exit\, the array is reified\, causing the refcount of the restored element to be off by one. One half of this patch fixes the SAVEt_AELEM code to handle this possibility.

In addition\, the scope exit (LEAVE) is currently done after the POPSUB - which checks for a reified @​_ and abandons it if necessary. So the check for reification comes too late. The second half of this patch moves the various LEAVEs to before the POPSUBs. This half I am more unsure about\, but it seems to pass the tests...

-- Standards (n). Battle insignia or tribal totems.

Inline Patch

```diff --- pp_ctl.c- Thu Mar 20 00:59:20 2003 +++ pp_ctl.c Thu Mar 20 01:04:19 2003 @@ -1949,6 +1949,7 @@ PP(pp_return) } PL_stack_sp = newsp; + LEAVE; /* Stack values are safe: */ if (popsub2) { POPSUB(cx,sv); /* release CV and @_ ... */ @@ -1957,7 +1958,6 @@ PP(pp_return) sv = Nullsv; PL_curpm = newpm; /* ... and pop $1 et al */ - LEAVE; LEAVESUB(sv); if (clear_errsv) sv_setpv(ERRSV,""); @@ -2033,6 +2033,7 @@ PP(pp_last) SP = newsp; PUTBACK; + LEAVE; /* Stack values are safe: */ switch (pop2) { case CXt_LOOP: @@ -2045,7 +2046,6 @@ PP(pp_last) } PL_curpm = newpm; /* ... and pop $1 et al */ - LEAVE; LEAVESUB(sv); return nextop; } --- pp_hot.c- Thu Mar 20 00:58:59 2003 +++ pp_hot.c Thu Mar 20 01:05:57 2003 @@ -2316,10 +2316,10 @@ PP(pp_leavesub) } PUTBACK; + LEAVE; POPSUB(cx,sv); /* Stack values are safe: release CV and @_ ... */ PL_curpm = newpm; /* ... and pop $1 et al */ - LEAVE; LEAVESUB(sv); return pop_return(); } @@ -2372,9 +2372,9 @@ PP(pp_leavesublv) * the refcounts so the caller gets a live guy. Cannot set * TEMP, so sv_2mortal is out of question. */ if (!CvLVALUE(cx->blk_sub.cv)) { + LEAVE; POPSUB(cx,sv); PL_curpm = newpm; - LEAVE; LEAVESUB(sv); DIE(aTHX_ "Can't modify non-lvalue subroutine call"); } @@ -2383,9 +2383,9 @@ PP(pp_leavesublv) EXTEND_MORTAL(1); if (MARK == SP) { if (SvFLAGS(TOPs) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) { + LEAVE; POPSUB(cx,sv); PL_curpm = newpm; - LEAVE; LEAVESUB(sv); DIE(aTHX_ "Can't return %s from lvalue subroutine", SvREADONLY(TOPs) ? (TOPs == &PL_sv_undef) ? "undef" @@ -2398,9 +2398,9 @@ PP(pp_leavesublv) } } else { /* Should not happen? */ + LEAVE; POPSUB(cx,sv); PL_curpm = newpm; - LEAVE; LEAVESUB(sv); DIE(aTHX_ "%s returned from lvalue subroutine in scalar context", (MARK > SP ? "Empty array" : "Array")); @@ -2414,9 +2414,9 @@ PP(pp_leavesublv) && SvFLAGS(*mark) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) { /* Might be flattened array after $#array = */ PUTBACK; + LEAVE; POPSUB(cx,sv); PL_curpm = newpm; - LEAVE; LEAVESUB(sv); DIE(aTHX_ "Can't return a %s from lvalue subroutine", SvREADONLY(TOPs) ? "readonly value" : "temporary"); @@ -2468,10 +2468,10 @@ PP(pp_leavesublv) } PUTBACK; + LEAVE; POPSUB(cx,sv); /* Stack values are safe: release CV and @_ ... */ PL_curpm = newpm; /* ... and pop $1 et al */ - LEAVE; LEAVESUB(sv); return pop_return(); } --- scope.c- Wed Mar 19 22:39:46 2003 +++ scope.c Wed Mar 19 23:26:05 2003 @@ -604,6 +604,9 @@ Perl_save_aelem(pTHX_ AV *av, I32 idx, S SSPUSHINT(idx); SSPUSHPTR(SvREFCNT_inc(*sptr)); SSPUSHINT(SAVEt_AELEM); + /* if it gets reified later, the restore will have the wrong refcnt */ + if (!AvREAL(av) && AvREIFY(av)) + SvREFCNT_inc(*sptr); save_scalar_at(sptr); sv = *sptr; /* If we're localizing a tied array element, this new sv @@ -963,6 +966,8 @@ Perl_leave_scope(pTHX_ I32 base) value = (SV*)SSPOPPTR; i = SSPOPINT; av = (AV*)SSPOPPTR; + if (!AvREAL(av) && AvREIFY(av)) /* undo reify guard */ + SvREFCNT_dec(value); ptr = av_fetch(av,i,1); if (ptr) { sv = *(SV**)ptr; --- t/op/args.t- Thu Mar 20 01:09:41 2003 +++ t/op/args.t Thu Mar 20 01:14:53 2003 @@ -1,6 +1,6 @@ #!./perl -print "1..9\n"; +print "1..10\n"; # test various operations on @_ @@ -73,3 +73,11 @@ for (1..5) { try() } ++$ord; print "ok $ord\n"; + +# bug #21542 local $_[0] causes reify problems and coredumps + +sub local1 { local $_[0] } +my $foo = 'foo'; local1($foo); local1($foo); +print "got [$foo], expected [foo]\nnot " if $foo ne 'foo'; +$ord++; +print "ok $ord\n"; ```

[p5pRT]

From @iabyn

On Thu\, Mar 20\, 2003 at 01​:26​:19AM +0000\, Dave Mitchell wrote​:

It's two related problems to do with the reification (is that a word?) of @​_.

Adi has pointed out to me a further coredump - this patch (to be applied on top of the previous one) fixes that too. The various paths to the restore_sv​: branch in leave_scope() all decremeted the ref count of the aggregate (av\, hv or gv)\, then restored the element. If the aggregate had a count of 1\, this could coredump. Now we restore\, *then* decrement.

Dave.

-- Justice is when you get what you deserve. Law is when you get what you pay for.

Inline Patch

```diff --- scope.c- Mon Mar 24 14:34:21 2003 +++ scope.c Mon Mar 24 15:06:39 2003 @@ -689,7 +689,7 @@ Perl_leave_scope(pTHX_ I32 base) value = (SV*)SSPOPPTR; gv = (GV*)SSPOPPTR; ptr = &GvSV(gv); - SvREFCNT_dec(gv); + av = (AV*)gv; /* what to refcnt_dec */ goto restore_sv; case SAVEt_GENERIC_PVREF: /* generic pv */ str = (char*)SSPOPPTR; @@ -722,6 +722,7 @@ Perl_leave_scope(pTHX_ I32 base) case SAVEt_SVREF: /* scalar reference */ value = (SV*)SSPOPPTR; ptr = SSPOPPTR; + av = Nullav; /* what to refcnt_dec */ restore_sv: sv = *(SV**)ptr; DEBUG_S(PerlIO_printf(Perl_debug_log, @@ -757,6 +758,8 @@ Perl_leave_scope(pTHX_ I32 base) SvSETMAGIC(value); PL_localizing = 0; SvREFCNT_dec(value); + if (av) /* actually an av, hv or gv */ + SvREFCNT_dec(av); break; case SAVEt_AV: /* array reference */ av = (AV*)SSPOPPTR; @@ -974,7 +977,6 @@ Perl_leave_scope(pTHX_ I32 base) if (sv && sv != &PL_sv_undef) { if (SvTIED_mg((SV*)av, PERL_MAGIC_tied)) (void)SvREFCNT_inc(sv); - SvREFCNT_dec(av); goto restore_sv; } } @@ -992,8 +994,8 @@ Perl_leave_scope(pTHX_ I32 base) ptr = &HeVAL((HE*)ptr); if (SvTIED_mg((SV*)hv, PERL_MAGIC_tied)) (void)SvREFCNT_inc(*(SV**)ptr); - SvREFCNT_dec(hv); SvREFCNT_dec(sv); + av = (AV*)hv; /* what to refcnt_dec */ goto restore_sv; } } --- t/op/args.t- Mon Mar 24 14:47:24 2003 +++ t/op/args.t Mon Mar 24 15:05:52 2003 @@ -1,6 +1,6 @@ #!./perl -print "1..10\n"; +print "1..11\n"; # test various operations on @_ @@ -79,5 +79,10 @@ sub local1 { local $_[0] } my $foo = 'foo'; local1($foo); local1($foo); print "got [$foo], expected [foo]\nnot " if $foo ne 'foo'; +$ord++; +print "ok $ord\n"; + +sub local2 { local $_[0]; last L } +L: { local2 } $ord++; print "ok $ord\n"; ```

[p5pRT]

From @jhi

Adi has pointed out to me a further coredump - this patch (to be applied on top of the previous one) fixes that too.

Both patches now applied (change #19064).

-- Jarkko Hietaniemi \jhi@​iki\.fi http​://www.iki.fi/jhi/ "There is this special biologist word we use for 'stable'. It is 'dead'." -- Jack Cohen

[p5pRT]

From @iabyn

closing call\, as I think I've fixed it....

[p5pRT]

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