From a70c2d5688349e997aaf662f41f2dfe6a9b1fe27 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Mon, 10 Sep 2012 22:29:15 -0700
Subject: [PATCH] Allow lexical sub redefinition inside eval

For non-clonable state subs, this already happened to work.

For any clonable subs, we need to clone the sub as soon as it
is defined.

For redefined state subs, we need to apply the new sub to all recur-
sion levels, as state subs are shared.
---
 op.c           | 39 ++++++++++++++++++++++++++++++++++++---
 t/cmd/lexsub.t | 20 +++++++++++++++++++-
 2 files changed, 55 insertions(+), 4 deletions(-)

diff --git a/op.c b/op.c
index ee5d7ee..4c1c1a9 100644
--- a/op.c
+++ b/op.c
@@ -6934,7 +6934,9 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     PADNAME *name;
     PADOFFSET pax = o->op_targ;
     CV *outcv = CvOUTSIDE(PL_compcv);
+    CV *clonee = NULL;
     HEK *hek = NULL;
+    bool reusable = FALSE;
 
     PERL_ARGS_ASSERT_NEWMYSUB;
 
@@ -6954,7 +6956,8 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	goto redo;
     }
     svspot =
-	&PadARRAY(PadlistARRAY(CvPADLIST(outcv))[1])[pax];
+	&PadARRAY(PadlistARRAY(CvPADLIST(outcv))
+			[CvDEPTH(outcv) ? CvDEPTH(outcv) : 1])[pax];
     spot = (CV **)svspot;
 
     if (proto) {
@@ -6977,7 +6980,11 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	goto done;
     }
 
-    if (PadnameIsSTATE(name))
+    if (CvDEPTH(outcv) && CvCLONE(compcv)) {
+	cv = *spot;
+	svspot = (SV **)(spot = &clonee);
+    }
+    else if (PadnameIsSTATE(name) || CvDEPTH(outcv))
 	cv = *spot;
     else {
 	MAGIC *mg;
@@ -7070,6 +7077,10 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 		cv = NULL;
 	    }
 	}
+	else if (CvDEPTH(outcv) && CvCLONE(compcv)) {
+	    cv = NULL;
+	    reusable = TRUE;
+	}
     }
     if (const_sv) {
 	SvREFCNT_inc_simple_void_NN(const_sv);
@@ -7093,7 +7104,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	op_free(block);
 	SvREFCNT_dec(compcv);
 	PL_compcv = NULL;
-	goto done;
+	goto clone;
     }
     /* Checking whether outcv is CvOUTSIDE(compcv) is not sufficient to
        determine whether this sub definition is in the same scope as its
@@ -7257,6 +7268,28 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	}
     }
 
+  clone:
+    if (clonee) {
+	assert(CvDEPTH(outcv));
+	spot = (CV **)
+	    &PadARRAY(PadlistARRAY(CvPADLIST(outcv))[CvDEPTH(outcv)])[pax];
+	if (reusable) cv_clone_into(clonee, *spot);
+	else *spot = cv_clone(clonee);
+	SvREFCNT_dec(clonee);
+	cv = *spot;
+	SvPADMY_on(cv);
+    }
+    if (CvDEPTH(outcv) && !reusable && PadnameIsSTATE(name)) {
+	PADOFFSET depth = CvDEPTH(outcv);
+	while (--depth) {
+	    SV *oldcv;
+	    svspot = &PadARRAY(PadlistARRAY(CvPADLIST(outcv))[depth])[pax];
+	    oldcv = *svspot;
+	    *svspot = SvREFCNT_inc_simple_NN(cv);
+	    SvREFCNT_dec(oldcv);
+	}
+    }
+
   done:
     if (PL_parser)
 	PL_parser->copline = NOLINE;
diff --git a/t/cmd/lexsub.t b/t/cmd/lexsub.t
index 24dc5b0..d7601b3 100644
--- a/t/cmd/lexsub.t
+++ b/t/cmd/lexsub.t
@@ -8,7 +8,7 @@ BEGIN {
     *bar::like = *like;
 }
 no warnings 'deprecated';
-plan 122;
+plan 124;
 
 # -------------------- our -------------------- #
 
@@ -290,6 +290,19 @@ sub make_anon_with_state_sub{
   state sub x;
   eval 'sub x {3}';
   is x, 3, 'state sub defined inside eval';
+
+  sub r {
+    state sub foo { 3 };
+    if (@_) { # outer call
+      r();
+      is foo(), 42,
+         'state sub run-time redefinition applies to all recursion levels';
+    }
+    else { # inner call
+      eval 'sub foo { 42 }';
+    }
+  }
+  r(1);
 }
 
 # -------------------- my -------------------- #
@@ -568,6 +581,11 @@ not_lexical11();
   x();
   is $count, 11, 'my recursive subs';
 }
+{
+  my sub x;
+  eval 'sub x {3}';
+  is x, 3, 'my sub defined inside eval';
+}
 
 # -------------------- Interactions (and misc tests) -------------------- #
 
-- 
2.7.4