From 86a64801a038eae8c8c1c6f0ba6a8b40aeb8fa8d Mon Sep 17 00:00:00 2001
From: Gerard Goossen <gerard@ggoossen.net>
Date: Thu, 11 Aug 2011 09:34:32 +0200
Subject: Move context propagation and finalize_optree from do_eval to newPROG

Aborting after errors found by finalize_optree in do_eval wasn't done
properly and would cause memory problems.
This patch moves the context propagation and finalize_optree to
newPROG such that the normal error handling is done.
The eval context blk_gimme is used to communicate the context.
---
 op.c     | 14 ++++++++++++++
 pp_ctl.c | 16 +---------------
 2 files changed, 15 insertions(+), 15 deletions(-)

diff --git a/op.c b/op.c
index a1443850f3..fabffe10aa 100644
--- a/op.c
+++ b/op.c
@@ -2704,11 +2704,23 @@ Perl_newPROG(pTHX_ OP *o)
     PERL_ARGS_ASSERT_NEWPROG;
 
     if (PL_in_eval) {
+	PERL_CONTEXT *cx;
 	if (PL_eval_root)
 		return;
 	PL_eval_root = newUNOP(OP_LEAVEEVAL,
 			       ((PL_in_eval & EVAL_KEEPERR)
 				? OPf_SPECIAL : 0), o);
+
+	cx = &cxstack[cxstack_ix];
+	assert(CxTYPE(cx) == CXt_EVAL);
+
+	if ((cx->blk_gimme & G_WANT) == G_VOID)
+	    scalarvoid(PL_eval_root);
+	else if ((cx->blk_gimme & G_WANT) == G_ARRAY)
+	    list(PL_eval_root);
+	else
+	    scalar(PL_eval_root);
+
 	/* don't use LINKLIST, since PL_eval_root might indirect through
 	 * a rather expensive function call and LINKLIST evaluates its
 	 * argument more than once */
@@ -2717,6 +2729,8 @@ Perl_newPROG(pTHX_ OP *o)
 	OpREFCNT_set(PL_eval_root, 1);
 	PL_eval_root->op_next = 0;
 	CALL_PEEP(PL_eval_start);
+	finalize_optree(PL_eval_root);
+
     }
     else {
 	if (o->op_type == OP_STUB) {
diff --git a/pp_ctl.c b/pp_ctl.c
index f226e0d940..c0a16e4e42 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3471,6 +3471,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
     CvEVAL_on(PL_compcv);
     assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL);
     cxstack[cxstack_ix].blk_eval.cv = PL_compcv;
+    cxstack[cxstack_ix].blk_gimme = gimme;
 
     CvOUTSIDE_SEQ(PL_compcv) = seq;
     CvOUTSIDE(PL_compcv) = MUTABLE_CV(SvREFCNT_inc_simple(outside));
@@ -3527,7 +3528,6 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
 	SV *namesv;
 	const char *msg;
 
-      parse_error:
 	cx = NULL;
 	namesv = NULL;
 	PERL_UNUSED_VAR(newsp);
@@ -3589,20 +3589,6 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
     } else
 	SAVEFREEOP(PL_eval_root);
 
-    /* Set the context for this new optree.
-     * Propagate the context from the eval(). */
-    if ((gimme & G_WANT) == G_VOID)
-	scalarvoid(PL_eval_root);
-    else if ((gimme & G_WANT) == G_ARRAY)
-	list(PL_eval_root);
-    else
-	scalar(PL_eval_root);
-
-    finalize_optree(PL_eval_root);
-
-    if (PL_parser->error_count) /* finalize_optree might have generated new error */
-	goto parse_error;
-
     DEBUG_x(dump_eval());
 
     /* Register with debugger: */
-- 
cgit v1.2.1