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

fix for SEGV in pp_leavesub #648

Closed
p5pRT opened this issue Sep 21, 1999 · 9 comments

Comments

@p5pRT
Copy link
Collaborator

@p5pRT p5pRT commented Sep 21, 1999

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

Searchable as RT1521$

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 21, 1999

From roconnor@world.std.com

The following code gets "Segmentation fault (core dumped)"​:

  #! /usr/bin/perl -w
  use ExtUtils​::testlib;
  use strict;
  use Mytest;
 
  my $w = MainWindow->new;
 
  my $b = $w->Button();
 
  $b->configure (-command => sub {my $t; $b->destroy; });
 
  $b->invoke;

"Mytest" can either be Tk or the following xs code, which is intended
to be a distillation of the key bug-related parts of what Tk is doing​:

  #ifdef __cplusplus
  extern "C" {
  #endif
  #include "EXTERN.h"
  #include "perl.h"
  #include "XSUB.h"
  #ifdef __cplusplus
  }
  #endif
 
 
  static SV * keepSub = (SV*)NULL ;
 
  MODULE = Mytest PACKAGE = Mytest
 
  SV *
  new (cv)
  SV * cv
  CODE​:
  ST(0) = sv_bless (newRV_noinc (newSVpv ("", 0)),
  gv_stashpv("Mytest", 0));
 
  void
  configure(cv,opt,name)
  SV * cv
  SV * opt
  SV * name
  CODE​:
  keepSub = newSVsv(name) ;
 
  void
  invoke(cv)
  SV * cv
  CODE​:
  PUSHMARK(sp) ;
  perl_call_sv(SvRV(keepSub), G_DISCARD|G_NOARGS) ;
 
  void
  destroy(cv)
  SV * cv
  CODE​:
  SvREFCNT_dec(keepSub) ;

The same thing happens with 5.004_04, 5.005_03, and perl.5005_61.

I spent some time tracking this down, and I believe that the problem
is as follows​:

When the callback executes the "my $t;", it does a SAVECLEARSV, which
puts an index into curpad on the savestack. Then at the end of the
callback, pp_leavesub does a POPSUB2 which frees the cv including
curpad, and then pp_leavesub does a LEAVE which tries to reference
curpad.

The obvious solution would seem to be not to decrement the refcnt on
the cv until after LEAVE, and I've included a patch below to do that.

I considered other possibilities.

Perhaps a sub should not be destroying the only reference to itself.
But it seems useful to do so, there seems to be no reason it should
not work, and since pp_entersub increments the refcnt, it seems to
allow for the possibilty as long as we don't decrement it too soon.

Perhaps we should not be putting references to curpad on the
savestack. But the cv was there when it did the SAVECLEARSV, and it
seems reasonable to keep it there until after the LEAVE.

Perhaps SAVECLEARSV should increment a refcnt. But the one
incremented by pp_entersub seems like it should cover it.

The PUSHBLOCK/PUSHSUB was done after the ENTER in pp_entersub, so to
keep the nesting consistent, it would seem that one would want to do
the POPSUB before the LEAVE. But decrementing the refcnt doesn't
really seem to be part of the POPSUB. pp_entersub increments it after
the PUSHSUB, but it can afford to do so because it knows that someone
else has a reference to the sub, and won't take it away before the end
of pp_entersub. Conceptually, it would be incrementing the refcnt
first thing, if it were convenient. So waiting until after the LEAVE
to decrement it is consistent with the nesting.

Guillaume Curtil <gui@​curtil.rez-gif.supelec.fr> reported what I
believe is the same bug in comp.lang.perl.tk on 1998/10/06. ("my" and
"destroy" in a Tk callback causing segfaults)

Alan Lehotsky <lehotsky@​phosgene.lex.rational.com> on 1999/07/06 in
perl.porters-gw reported that "Perl seems to deallocate the array
addressed via 'curpad' too soon", but didn't give a test case.

In my patch, I didn't just move POPSUB2 after LEAVE, because it seemed
to belong before LEAVE, and I didn't want to change anything that
wasn't necessary to fix the problem. Instead, I separated just the
decrement of the refcnt from POPSUB2, and called it POPSUB2B, and put
that after LEAVE. I renamed the remainder of POPSUB2 to POPSUB2A, so
anyone who was using POPSUB2 from the header file would have it break,
instead of just silently stop working. I put POPSUB2B after leave in
pp_return and pp_last as well, because they seemed to have the same
problem. I didn't change the POPSUB in dounwind, because it doesn't
seem to be followed by a LEAVE that depends on a curpad that might
have been freed.

The patch should be fairly safe, because in the normal case (when the
cv is not being freed) it has no effect other than to decrement the
refcnt after the LEAVE instead of before.

The patch is a unified diff against 4.004_04 with only one line of
context, so it will apply against 5.005_03, and 5.005_61 as well.

begin 644 patch.gz
M'XL("'BVYS<``W!A=&-H`,U478^​:0!1]AE]Q-VTVL@​@​+*)_&Q(^ZZ4/;-=5N
M^]#$(([5K`L$1G>;QO_>.X/`N+​:[ID_E82#<KW//.​:!I&D1)JJ]T0[K)UO`Q
M_`G@​@​V4$5BNP33!]WY5552V2I$E(84)2,#TPS<"P@​C9/\>5>#S3;;+9`Q;,-
MO9X,$L#X=CSY,C`;T9/2D8KKNZQ5`​:NA=&`OJ_6+?D-(%-X/BDPHYCA\CHLG
MFR-K;Q9DN8Y)W;5N\2S4%V(@​K9>`T/+M7%^%>9C]R!7X54;9(,=N.J`Z3M,K
M%MI+PA)U<;2KZ@​[K`;#H16.X>S<​:3]\+>5THGI/-8D%2NE*40Y$TV7T>W0P_
M36<+$M4%G​:HKX^EXYA%1`*\/Z\CJ"2,#D​:VC`7!Y"1<G315QY%\P,TW05VDZ
MB^A&C]!​:TRWAOD%KH6]L.V@​YM;7*O"K+,EE6RPULMW​:7V?;;3'=^+QQ6$ITF
M*8ZV4`7DJ;​:6='T%&=F0,"<PO(,P7D!O!KJNP]4U+B!​:#C,G-(SN81=NMB2'
M,".0ATL25`VPDE=)++<QWU*($XIMF_!AU+\;P0-^.#$A"UA3Y3""X]N7X/VF
MA>!MPT!/E>!Y*5?E#ZM4"`<'A''R*.[#X/`)4%Q%RXS0;18#]ID5CUA<0+!=
MF_-G>X;`7\2[?​:,SG!3\7_1)\XR$]R5ZSRP(]-S7"+2@​VRU7.B7R)2​:/*(S)
M$TW23FGE54*YE;\BR-N(`N`OT,!?9&`91U;F><^M[`6V)UC9<5M<"G​:WJV5D
MC9V"`&?P>BJ,T*-_9I-_$$<]N&>;I0_XGXG)8_K`?<#B#!'J`&]-(!3"#2LX
9[.UR$1W7%_8^%O$,K5YP^F_$*)!FT`8`````
`
end

Perl Info


Site configuration information for perl 5.00404:

Configured by torin at Wed Feb  3 00:50:04 PST 1999.

Summary of my perl5 (5.0 patchlevel 4 subversion 4) configuration:
  Platform:
    osname=linux, osvers=2.0.36, archname=i386-linux
    uname='linux perv 2.0.36 #2 wed nov 18 03:00:48 pst 1998 i686 unknown '
    hint=recommended, useposix=true, d_sigaction=define
    bincompat3=n useperlio=undef d_sfio=undef
  Compiler:
    cc='cc', optimize='-O2', gccversion=2.7.2.3
    cppflags='-Dbool=char -DHAS_BOOL -D_REENTRANT'
    ccflags ='-Dbool=char -DHAS_BOOL -D_REENTRANT'
    stdchar='char', d_stdstdio=define, usevfork=false
    voidflags=15, castflags=0, d_casti32=define, d_castneg=define
    intsize=4, alignbytes=4, usemymalloc=n, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib
    libs=-lnsl -lndbm -lgdbm -ldbm -ldb -ldl -lm -lc -lposix -lcrypt
    libc=, so=so
    useshrplib=false, libperl=libperl.a
  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 5.00404:
	/usr/lib/perl5/i386-linux/5.004
	/usr/lib/perl5
	/usr/local/lib/site_perl/i386-linux
	/usr/local/lib/site_perl
	.


Environment for perl 5.00404:
    HOME=/root
    LANG (unset)
    LD_LIBRARY_PATH=/usr/local/rvplayer5.0
    LOGDIR (unset)
    PATH=/usr/local/perl/bin:/usr/local/bin:/usr/local/scripts:/usr/bin:/usr/sbin:/bin:/sbin:/usr/bin/X11:/usr/games:/usr/andrew/bin:/usr/local/rvplayer5.0:.
    PERL_BADLANG (unset)
    SHELL=/bin/bash

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 21, 1999

From [Unknown Contact. See original ticket]

root writes​:

The following code gets "Segmentation fault (core dumped)"​:

    \#\! /usr/bin/perl \-w
    use ExtUtils&#8203;::testlib;
    use strict;
    use Mytest;
    
    my $w = MainWindow\->new;
    
    my $b = $w\->Button\(\);
    
    $b\->configure \(\-command => sub \{my $t; $b\->destroy; \}\);
    
    $b\->invoke;

"Mytest" can either be Tk or the following xs code, which is intended
to be a distillation of the key bug-related parts of what Tk is doing​:

    \#ifdef \_\_cplusplus
    extern "C" \{
    \#endif
    \#include "EXTERN\.h"
    \#include "perl\.h"
    \#include "XSUB\.h"
    \#ifdef \_\_cplusplus
    \}
    \#endif
    
    
    static SV \* keepSub = \(SV\*\)NULL ;
    
    MODULE = Mytest        PACKAGE = Mytest        
    
    SV \*
    new \(cv\)
        SV \*    cv
        CODE&#8203;:
        ST\(0\) = sv\_bless \(newRV\_noinc \(newSVpv \(""\, 0\)\)\,
                          gv\_stashpv\("Mytest"\, 0\)\);

I do not see any mortalization here. This indicates that the code is
probably *very* broken.

Ilya

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 23, 1999

From [Unknown Contact. See original ticket]

Ilya writes​:

I do not see any mortalization here. This indicates that the code is
probably *very* broken.

Here is a better test case​:

  #! /usr/bin/perl -w
  use ExtUtils​::testlib;
  use strict;
  use Mytest;
 
  my $b = Mytest->new;
 
  $b->configure (sub {my $t; $b->destroy; });
 
  $b->invoke;
 
  package Mytest;
  sub new { bless {} }

And the xs code that goes with it​:

  #ifdef __cplusplus
  extern "C" {
  #endif
  #include "EXTERN.h"
  #include "perl.h"
  #include "XSUB.h"
  #ifdef __cplusplus
  }
  #endif
 
  static SV * keepSub = (SV*)NULL ;
 
  MODULE = Mytest PACKAGE = Mytest
 
  void
  configure(obj,name)
  SV * obj
  SV * name
  CODE​:
  keepSub = newSVsv(name) ;
 
  void
  invoke(obj)
  SV * obj
  CODE​:
  PUSHMARK(sp) ;
  perl_call_sv(keepSub, G_DISCARD|G_NOARGS) ;
 
  void
  destroy(obj)
  SV * obj
  CODE​:
  SvREFCNT_dec(keepSub) ;

I built perl5.004_04 with optimize='-g' and -lmcheck added to the
libs and usemymalloc='n' so that it would use glibc's malloc with
checking. It then segfaults in leave_scope (scope.c​:599) when it
tries to use a pointer stored in curpad[1], which has been freed and
filled with 0x95959595 by mcheck's free routine.

Here is the traceback​:

#0 0x80cab2c in Perl_leave_scope (base=17) at scope.c​:599
#1 0x80c8d99 in Perl_pop_scope () at scope.c​:72
#2 0x80a1820 in Perl_pp_leavesub () at pp_hot.c​:1677
#3 0x809b1a6 in Perl_runops () at run.c​:58
#4 0x8059781 in perl_call_sv (sv=0x8151d1c, flags=10) at perl.c​:1130
#5 0x4000d877 in XS_Mytest_invoke ()
#6 0x80a1fb4 in Perl_pp_entersub () at pp_hot.c​:1832
#7 0x809b1a6 in Perl_runops () at run.c​:58
#8 0x8058d46 in perl_run (sv_interp=0x8103850) at perl.c​:918
#9 0x80561eb in main (argc=2, argv=0xbffffbc4, env=0xbffffbd0) at perlmain.c​:52
(gdb) p Perl_curpad[1]
$1 = (SV *) 0x95959595

When I apply the patch I sent, there is no segfault.

Here is the information for the perl I used for the traceback​:


Site configuration information for perl 5.00404​:

Configured by root at Tue Sep 21 18​:19​:48 EDT 1999.

Summary of my perl5 (5.0 patchlevel 4 subversion 4) configuration​:
  Platform​:
  osname=linux, osvers=2.0.36, archname=i586-linux
  uname='linux russ 2.0.36 #1 sun dec 13 16​:02​:00 est 1998 i586
unknown '
  hint=recommended, useposix=true, d_sigaction=define
  bincompat3=y useperlio=undef d_sfio=undef
  Compiler​:
  cc='cc', optimize='-g', gccversion=2.7.2.3
  cppflags='-Dbool=char -DHAS_BOOL -DDEBUGGING -I/usr/local/include'
  ccflags ='-Dbool=char -DHAS_BOOL -DDEBUGGING -I/usr/local/include'
  stdchar='char', d_stdstdio=define, usevfork=false
  voidflags=15, castflags=0, d_casti32=define, d_castneg=define
  intsize=4, alignbytes=4, usemymalloc=n, prototype=define
  Linker and Libraries​:
  ld='cc', ldflags =' -L/usr/local/lib'
  libpth=/usr/local/lib /lib /usr/lib
  libs=-lnsl -lndbm -lgdbm -ldb -ldl -lm -lc -lposix -lcrypt
-lmcheck
  libc=, so=so
  useshrplib=false, libperl=libperl.a
  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 5.00404​:
  /usr/local/perl/lib/i586-linux/5.00404
  /usr/local/perl/lib
  /usr/local/perl/lib/site_perl/i586-linux
  /usr/local/perl/lib/site_perl
  .


Environment for perl 5.00404​:
  HOME=/root
  LANG (unset)
  LD_LIBRARY_PATH=/usr/local/rvplayer5.0
  LOGDIR (unset)
  PATH=/usr/local/perl/bin​:/usr/local/bin​:/usr/local/scripts​:/usr/bin​:/usr/sbin​:/bin​:/sbin​:/usr/bin/X11​:/usr/g
ames​:/usr/andrew/bin​:/usr/local/rvplayer5.0​:.
  PERL_BADLANG (unset)
  SHELL=/bin/bash


Russ

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 24, 1999

From [Unknown Contact. See original ticket]

Russell O'Connor <roconnor@​world.std.com> writes​:

Ilya writes​:

I do not see any mortalization here. This indicates that the code is
probably *very* broken.

I do see the problem with real-Tk, but suicidal buttons, called outside
MainLoop, by calling internal methods is not a typical use ;-)

   \#ifdef \_\_cplusplus
   extern "C" \{
   \#endif
   \#include "EXTERN\.h"
   \#include "perl\.h"
   \#include "XSUB\.h"
   \#ifdef \_\_cplusplus
   \}
   \#endif
   
   static SV \* keepSub = \(SV\*\)NULL ;
   
   MODULE = Mytest         PACKAGE = Mytest                
   
   void
   configure\(obj\,name\)
       SV \*    obj
       SV \*    name
       CODE&#8203;:
       keepSub = newSVsv\(name\) ;
   
   void
   invoke\(obj\)
       SV \*    obj
       CODE&#8203;:
       PUSHMARK\(sp\) ;
       perl\_call\_sv\(keepSub\, G\_DISCARD|G\_NOARGS\) ;

G_NOARGS is not apporpriate. And all Tk callbacks are called with G_EVAL,
and are always wrapped in ENTER/LEAVE
Do you get same problem with

  ENTER;
  PUSHMARK(sp);
  perl_call_sv(keepSub, G_DISCARD|G_EVAL) ;
  LEAVE;

--
Nick Ing-Simmons <nik@​tiuk.ti.com>
Via, but not speaking for​: Texas Instruments Ltd.

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 24, 1999

From [Unknown Contact. See original ticket]

Nick Ing-Simmons writes​:

I do see the problem with real-Tk, but suicidal buttons, called outside
MainLoop, by calling internal methods is not a typical use ;-)

Agreed. The peculiarities were to simplify the test case. Make this
change to demos/widtrib/balloon.pl and it will die the same way when
you press the "Something Unexpected" button a few times ;-)

  --- balloon.pl.0 Thu Sep 17 21​:07​:17 1998
  +++ balloon.pl Fri Sep 24 11​:49​:16 1999
  @​@​ -35,3 +35,3 @​@​
  my $b1 = $top->Button(-text => "Something Unexpected",
  - -command => sub {$top->destroy;});
  + -command => sub {my $a; $top->destroy;});
  my $b2 = $top->Button(-text => "Something Else Unexpected");

G_NOARGS is not apporpriate. And all Tk callbacks are called with G_EVAL,
and are always wrapped in ENTER/LEAVE
Do you get same problem with

         ENTER; 
         PUSHMARK\(sp\);
         perl\_call\_sv\(keepSub\, G\_DISCARD|G\_EVAL\) ;
         LEAVE;

Yes.

--
Russell O'Connor <roconnor@​world.std.com>

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 24, 1999

From @gsar

On Fri, 24 Sep 1999 12​:06​:53 EDT, "Russell O'Connor" wrote​:

Nick Ing-Simmons writes​:

I do see the problem with real-Tk, but suicidal buttons, called outside
MainLoop, by calling internal methods is not a typical use ;-)

Agreed. The peculiarities were to simplify the test case. Make this
change to demos/widtrib/balloon.pl and it will die the same way when
you press the "Something Unexpected" button a few times ;-)

The problem you have identified is real. I'll look at your fix to
see if it can be made simpler, thanks.

Sarathy
gsar@​activestate.com

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 24, 1999

From [Unknown Contact. See original ticket]

Russell O'Connor <roconnor@​world.std.com> writes​:

Nick Ing-Simmons writes​:

I do see the problem with real-Tk, but suicidal buttons, called outside
MainLoop, by calling internal methods is not a typical use ;-)

Agreed. The peculiarities were to simplify the test case.

An axcellent idea in general.

Make this
change to demos/widtrib/balloon.pl and it will die the same way when
you press the "Something Unexpected" button a few times ;-)

--- balloon.pl.0 Thu Sep 17 21​:07​:17 1998
+++ balloon.pl Fri Sep 24 11​:49​:16 1999
@​@​ -35,3 +35,3 @​@​
my $b1 = $top->Button(-text => "Something Unexpected",
- -command => sub {$top->destroy;});
+ -command => sub {my $a; $top->destroy;});
my $b2 = $top->Button(-text => "Something Else Unexpected");

What is the 'signature' that causes the problem?
There are lots of subs with my variables in live working Tk code!
Is it ->destroy or the fact that variable is not really used?

G_NOARGS is not apporpriate. And all Tk callbacks are called with G_EVAL,
and are always wrapped in ENTER/LEAVE
Do you get same problem with

         ENTER; 
         PUSHMARK\(sp\);
         perl\_call\_sv\(keepSub\, G\_DISCARD|G\_EVAL\) ;
         LEAVE;

Yes.

Fine.

--
Nick Ing-Simmons

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 24, 1999

From @gsar

On Fri, 24 Sep 1999 18​:45​:26 BST, Nick Ing-Simmons wrote​:

Russell O'Connor <roconnor@​world.std.com> writes​:

change to demos/widtrib/balloon.pl and it will die the same way when
you press the "Something Unexpected" button a few times ;-)

--- balloon.pl.0 Thu Sep 17 21​:07​:17 1998
+++ balloon.pl Fri Sep 24 11​:49​:16 1999
@​@​ -35,3 +35,3 @​@​
my $b1 = $top->Button(-text => "Something Unexpected",
- -command => sub {$top->destroy;});
+ -command => sub {my $a; $top->destroy;});
my $b2 = $top->Button(-text => "Something Else Unexpected");

What is the 'signature' that causes the problem?
There are lots of subs with my variables in live working Tk code!
Is it ->destroy or the fact that variable is not really used?

It's the $top->destroy.

Sarathy
gsar@​activestate.com

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Mar 21, 2000

From [Unknown Contact. See original ticket]

Root <roconnor@​world.std.com> writes​:

This is a bug report for perl from roconnor@​world.std.com,
generated with the help of perlbug 1.20 running under perl 5.00404.

-----------------------------------------------------------------

The same thing happens with 5.004_04, 5.005_03, and perl.5005_61.

The fix is in perl5.6.0 - and the root cause of the worst cases is
fixed in Tk800.019 (perl attempts to avoud the issue with an SvREFCNT_inc
on entry which LEAVE undoes as you note below, Tk though has had
"for a while" a bug where by bare "subs" as callbacks had REFCNT
one too low - which meant CV went too early even with the fix.)

But as perl5.005_03 and earlier do NOT have the fix Tk800.020 will
restore my "stronger" fix which I (foolishly) backed out before releaseing
Tk800.019 as "unnecessary" after testing against perl5.6.0.

The strong fix is to increment REFCNT of CV before passing to perl_call_sv
and decrement on return.

Many thanks for your helpful e-mail (and the fix of course) which showed
me when I re-read it that the problem was real even when REFCNT was
"correct".

I spent some time tracking this down,

So have I :-( - I should pay more attention to the things I have
flagged in my mail box!

and I believe that the problem
is as follows​:

When the callback executes the "my $t;", it does a SAVECLEARSV, which
puts an index into curpad on the savestack. Then at the end of the
callback, pp_leavesub does a POPSUB2 which frees the cv including
curpad, and then pp_leavesub does a LEAVE which tries to reference
curpad.

The obvious solution would seem to be not to decrement the refcnt on
the cv until after LEAVE, and I've included a patch below to do that.

I considered other possibilities.

Perhaps a sub should not be destroying the only reference to itself.
But it seems useful to do so, there seems to be no reason it should
not work, and since pp_entersub increments the refcnt, it seems to
allow for the possibilty as long as we don't decrement it too soon.

Perhaps we should not be putting references to curpad on the
savestack. But the cv was there when it did the SAVECLEARSV, and it
seems reasonable to keep it there until after the LEAVE.

Perhaps SAVECLEARSV should increment a refcnt. But the one
incremented by pp_entersub seems like it should cover it.

The PUSHBLOCK/PUSHSUB was done after the ENTER in pp_entersub, so to
keep the nesting consistent, it would seem that one would want to do
the POPSUB before the LEAVE. But decrementing the refcnt doesn't
really seem to be part of the POPSUB. pp_entersub increments it after
the PUSHSUB, but it can afford to do so because it knows that someone
else has a reference to the sub, and won't take it away before the end
of pp_entersub. Conceptually, it would be incrementing the refcnt
first thing, if it were convenient. So waiting until after the LEAVE
to decrement it is consistent with the nesting.

Guillaume Curtil <gui@​curtil.rez-gif.supelec.fr> reported what I
believe is the same bug in comp.lang.perl.tk on 1998/10/06. ("my" and
"destroy" in a Tk callback causing segfaults)

Alan Lehotsky <lehotsky@​phosgene.lex.rational.com> on 1999/07/06 in
perl.porters-gw reported that "Perl seems to deallocate the array
addressed via 'curpad' too soon", but didn't give a test case.

In my patch, I didn't just move POPSUB2 after LEAVE, because it seemed
to belong before LEAVE, and I didn't want to change anything that
wasn't necessary to fix the problem. Instead, I separated just the
decrement of the refcnt from POPSUB2, and called it POPSUB2B, and put
that after LEAVE. I renamed the remainder of POPSUB2 to POPSUB2A, so
anyone who was using POPSUB2 from the header file would have it break,
instead of just silently stop working. I put POPSUB2B after leave in
pp_return and pp_last as well, because they seemed to have the same
problem. I didn't change the POPSUB in dounwind, because it doesn't
seem to be followed by a LEAVE that depends on a curpad that might
have been freed.

The patch should be fairly safe, because in the normal case (when the
cv is not being freed) it has no effect other than to decrement the
refcnt after the LEAVE instead of before.

The patch is a unified diff against 4.004_04 with only one line of
context, so it will apply against 5.005_03, and 5.005_61 as well.

begin 644 patch.gz
M'XL("'BVYS<``W!A=&-H`,U478^​:0!1]AE]Q-VTVL@​@​+*)_&Q(^ZZ4/;-=5N
M^]#$(([5K`L$1G>;QO_>.X/`N+​:[ID_E82#<KW//.​:!I&D1)JJ]T0[K)UO`Q
M_`G@​@​V4$5BNP33!]WY5552V2I$E(84)2,#TPS<"P@​C9/\>5>#S3;;+9`Q;,-
MO9X,$L#X=CSY,C`;T9/2D8KKNZQ5`​:NA=&`OJ_6+?D-(%-X/BDPHYCA\CHLG
MFR-K;Q9DN8Y)W;5N\2S4%V(@​K9>`T/+M7%^%>9C]R!7X54;9(,=N.J`Z3M,K
M%MI+PA)U<;2KZ@​[K`;#H16.X>S<​:3]\+>5THGI/-8D%2NE*40Y$TV7T>W0P_
M36<+$M4%G​:HKX^EXYA%1`*\/Z\CJ"2,#D​:VC`7!Y"1<G315QY%\P,TW05VDZ
MB^A&C]!​:TRWAOD%KH6]L.V@​YM;7*O"K+,EE6RPULMW​:7V?;;3'=^+QQ6$ITF
M*8ZV4`7DJ;​:6='T%&=F0,"<PO(,P7D!O!KJNP]4U+B!​:#C,G-(SN81=NMB2'
M,".0ATL25`VPDE=)++<QWU*($XIMF_!AU+\;P0-^.#$A"UA3Y3""X]N7X/VF
MA>!MPT!/E>!Y*5?E#ZM4"`<'A''R*.[#X/`)4%Q%RXS0;18#]ID5CUA<0+!=
MF_-G>X;`7\2[?​:,SG!3\7_1)\XR$]R5ZSRP(]-S7"+2@​VRU7.B7R)2​:/*(S)
M$TW23FGE54*YE;\BR-N(`N`OT,!?9&`91U;F><^M[`6V)UC9<5M<"G​:WJV5D
MC9V"`&?P>BJ,T*-_9I-_$$<]N&>;I0_XGXG)8_K`?<#B#!'J`&]-(!3"#2LX
9[.UR$1W7%_8^%O$,K5YP^F_$*)!FT`8`````
`
end

[Please do not change anything below this line]
-----------------------------------------------------------------

---
Site configuration information for perl 5.00404​:

Configured by torin at Wed Feb 3 00​:50​:04 PST 1999.

Summary of my perl5 (5.0 patchlevel 4 subversion 4) configuration​:
Platform​:
osname=linux, osvers=2.0.36, archname=i386-linux
uname='linux perv 2.0.36 #2 wed nov 18 03​:00​:48 pst 1998 i686 unknown '
hint=recommended, useposix=true, d_sigaction=define
bincompat3=n useperlio=undef d_sfio=undef
Compiler​:
cc='cc', optimize='-O2', gccversion=2.7.2.3
cppflags='-Dbool=char -DHAS_BOOL -D_REENTRANT'
ccflags ='-Dbool=char -DHAS_BOOL -D_REENTRANT'
stdchar='char', d_stdstdio=define, usevfork=false
voidflags=15, castflags=0, d_casti32=define, d_castneg=define
intsize=4, alignbytes=4, usemymalloc=n, prototype=define
Linker and Libraries​:
ld='cc', ldflags =' -L/usr/local/lib'
libpth=/usr/local/lib /lib /usr/lib
libs=-lnsl -lndbm -lgdbm -ldbm -ldb -ldl -lm -lc -lposix -lcrypt
libc=, so=so
useshrplib=false, libperl=libperl.a
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 5.00404​:
/usr/lib/perl5/i386-linux/5.004
/usr/lib/perl5
/usr/local/lib/site_perl/i386-linux
/usr/local/lib/site_perl
.

---
Environment for perl 5.00404​:
HOME=/root
LANG (unset)
LD_LIBRARY_PATH=/usr/local/rvplayer5.0
LOGDIR (unset)
PATH=/usr/local/perl/bin​:/usr/local/bin​:/usr/local/scripts​:/usr/bin​:/usr/sbin​:/bin​:/sbin​:/usr/bin/X11​:/usr/games​:/usr/andrew/bin​:/usr/local/rvplayer5.0​:.
PERL_BADLANG (unset)
SHELL=/bin/bash
--
Nick Ing-Simmons <nik@​tiuk.ti.com>
Via, but not speaking for​: Texas Instruments Ltd.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
1 participant
You can’t perform that action at this time.