From e4bfbed39bdcbc5cd76c9cdfdeb3314c3710ad62 Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Mon, 4 Jun 2012 13:24:23 +0100
Subject: handle weird/undef (?{}), (??{}) return value

All three code block variants: (?{}), (??{}), (?(?{}X|Y)),
make use of the return value of the block, either to set $^R, determine
truth, or to interpret as a pattern.  Evaluating this value may trigger
magic calls, uninitialized var warnings etc. Make sure that this
processing happens in the right environment; specifically, before we've
restored vars and paren indices, and we set PL_op temporarily to NULL so
that uninit var warnings don't try to look in the wrong place: neither the
outer op (eg OP_MATCH) nor the inner op (the last op of the code block:
currently happens to be OP_NULL, but that's a bug; will eventually be last
*real* op, e.g. padsv) are suitable for identifying where the warning came
from.

For the (??{}) case, if we can't extract a pre-compiled regex from it,
we force it to a PV, making a temp copy if necessary.
---
 regexec.c | 68 ++++++++++++++++++++++++++++++++++++---------------------------
 1 file changed, 39 insertions(+), 29 deletions(-)

(limited to 'regexec.c')

diff --git a/regexec.c b/regexec.c
index 1ae61c3c7b..9c4b53d29c 100644
--- a/regexec.c
+++ b/regexec.c
@@ -4404,6 +4404,40 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 		    PUTBACK;
 		}
 
+		/* before restoring everything, evaluate the returned
+		 * value, so that 'uninit' warnings don't use the wrong
+		 * PL_op or pad. Also need to process any magic vars (e.g.
+		 * $1 *before* parentheses are restored */
+
+		PL_op = NULL;
+
+		if (logical == 0)        /*   (?{})/   */
+		    sv_setsv(save_scalar(PL_replgv), ret); /* $^R */
+		else if (logical == 1) { /*   /(?(?{...})X|Y)/    */
+		    sw = cBOOL(SvTRUE(ret));
+		    logical = 0;
+		}
+		else {                   /*  /(??{})  */
+		    SV *sv = ret;
+		    re_sv = NULL;
+		    if (SvROK(sv))
+			sv = SvRV(sv);
+		    if (SvTYPE(sv) == SVt_REGEXP)
+			re_sv = (REGEXP*) sv;
+		    else if (SvSMAGICAL(sv)) {
+			MAGIC *mg = mg_find(sv, PERL_MAGIC_qr);
+			if (mg)
+			    re_sv = (REGEXP *) mg->mg_obj;
+		    }
+
+		    /* force any magic, undef warnings here */
+		    if (!re_sv && !SvAMAGIC(ret)) {
+			ret = sv_mortalcopy(ret);
+			(void) SvPV_force_nolen(ret);
+		    }
+
+		}
+
 		Copy(&saved_state, &PL_reg_state, 1, struct re_save_state);
 
 		/* *** Note that at this point we don't restore
@@ -4413,36 +4447,18 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 		PL_op = oop;
 		PL_curcop = ocurcop;
 		PL_regeol = saved_regeol;
-		if (!logical) {
-		    /* /(?{...})/ */
-		    /* restore all paren positions. Note that where the
-		     * return value is used, we must delay this as the
-		     * returned string to be compiled may be $1 for
-		     * example */
-		    S_regcp_restore(aTHX_ rex, runops_cp);
-		    sv_setsv(save_scalar(PL_replgv), ret);
+		S_regcp_restore(aTHX_ rex, runops_cp);
+
+		if (logical != 2)
 		    break;
-		}
 	    }
-	    if (logical == 2) { /* Postponed subexpression: /(??{...})/ */
+
+		/* only /(??{})/  from now on */
 		logical = 0;
 		{
 		    /* extract RE object from returned value; compiling if
 		     * necessary */
 
-		    re_sv = NULL;
-		    {
-			SV *sv = ret;
-			if (SvROK(sv))
-			    sv = SvRV(sv);
-			if (SvTYPE(sv) == SVt_REGEXP) {
-			    re_sv = (REGEXP*) sv;
-			} else if (SvSMAGICAL(sv)) {
-			    MAGIC *mg = mg_find(sv, PERL_MAGIC_qr);
-			    if (mg)
-				re_sv = (REGEXP *) mg->mg_obj;
-			}
-		    }
 		    if (re_sv) {
 			re_sv = reg_temp_copy(NULL, re_sv);
 		    }
@@ -4527,12 +4543,6 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 		/* now continue from first node in postoned RE */
 		PUSH_YES_STATE_GOTO(EVAL_AB, startpoint);
 		/* NOTREACHED */
-	    }
-	    /* logical is 1,   /(?(?{...})X|Y)/ */
-	    sw = cBOOL(SvTRUE(ret));
-	    S_regcp_restore(aTHX_ rex, runops_cp);
-	    logical = 0;
-	    break;
 	}
 
 	case EVAL_AB: /* cleanup after a successful (??{A})B */
-- 
cgit v1.2.1