From: Gurusamy Sarathy Date: Fri, 4 Feb 2000 04:45:13 +0000 (+0000) Subject: fix pad_alloc panic from C X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=354992b151c6d0f4f02b9e65e8ba749a959e700d;p=p5sagit%2Fp5-mst-13.2.git fix pad_alloc panic from C p4raw-id: //depot/perl@4970 --- diff --git a/op.c b/op.c index 953ee1c..456d786 100644 --- a/op.c +++ b/op.c @@ -4084,8 +4084,7 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside) assert(!CvUNIQUE(proto)); ENTER; - SAVEVPTR(PL_curpad); - SAVESPTR(PL_comppad); + SAVECOMPPAD(); SAVESPTR(PL_comppad_name); SAVESPTR(PL_compcv); diff --git a/scope.c b/scope.c index 7052282..91e0374 100644 --- a/scope.c +++ b/scope.c @@ -934,6 +934,13 @@ Perl_leave_scope(pTHX_ I32 base) } *(I32*)&PL_hints = (I32)SSPOPINT; break; + case SAVEt_COMPPAD: + PL_comppad = (AV*)SSPOPPTR; + if (PL_comppad) + PL_curpad = AvARRAY(PL_comppad); + else + PL_curpad = Null(SV**); + break; default: Perl_croak(aTHX_ "panic: leave_scope inconsistency"); } diff --git a/scope.h b/scope.h index f90e7c5..fa21199 100644 --- a/scope.h +++ b/scope.h @@ -31,6 +31,7 @@ #define SAVEt_DESTRUCTOR_X 30 #define SAVEt_VPTR 31 #define SAVEt_I8 32 +#define SAVEt_COMPPAD 33 #define SSCHECK(need) if (PL_savestack_ix + need > PL_savestack_max) savestack_grow() #define SSPUSHINT(i) (PL_savestack[PL_savestack_ix++].any_i32 = (I32)(i)) @@ -132,6 +133,19 @@ Closing bracket on a callback. See C and L. } \ } STMT_END +#define SAVECOMPPAD() \ + STMT_START { \ + if (PL_comppad && PL_curpad == AvARRAY(PL_comppad)) { \ + SSCHECK(2); \ + SSPUSHPTR((SV*)PL_comppad); \ + SSPUSHINT(SAVEt_COMPPAD); \ + } \ + else { \ + SAVEVPTR(PL_curpad); \ + SAVESPTR(PL_comppad); \ + } \ + } STMT_END + #ifdef USE_ITHREADS # define SAVECOPSTASH(cop) SAVEPPTR(CopSTASHPV(cop)) # define SAVECOPFILE(cop) SAVEPPTR(CopFILE(cop)) diff --git a/t/op/closure.t b/t/op/closure.t index 52d2272..c691d6f 100755 --- a/t/op/closure.t +++ b/t/op/closure.t @@ -12,7 +12,7 @@ BEGIN { use Config; -print "1..170\n"; +print "1..171\n"; my $test = 1; sub test (&) { @@ -172,6 +172,15 @@ test { $foo[4]->()->(4) }; +{ + my $w; + $w = sub { + my ($i) = @_; + test { $i == 10 }; + sub { $w }; + }; + $w->(10); +} # Additional tests by Tom Phoenix . diff --git a/toke.c b/toke.c index fb30144..55ffda3 100644 --- a/toke.c +++ b/toke.c @@ -7039,8 +7039,7 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags) SAVEI32(PL_subline); save_item(PL_subname); SAVEI32(PL_padix); - SAVEVPTR(PL_curpad); - SAVESPTR(PL_comppad); + SAVECOMPPAD(); SAVESPTR(PL_comppad_name); SAVESPTR(PL_compcv); SAVEI32(PL_comppad_name_fill);