fix pad_alloc panic from C<my $w; sub { my($i) = @_; sub { $w } }>

p4raw-id: //depot/perl@4970

diff --git a/op.c b/op.c
index 953ee1c..456d786 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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<ENTER> and L<perlcall>.
        }                                       \
     } 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 (executable)
--- 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 <rootbeer@teleport.com>.
 

diff --git a/toke.c b/toke.c
index fb30144..55ffda3 100644 (file)
--- 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);