[perl #113684] Make redo/last/next/dump accept expr

These functions have been allowing arbitrary expressions, but would
treat anything that did not resolve to a const op as the empty string.
Not only were arguments swallowed up without warning, but constant
folding could change the behaviour.  Computed labels are allowed for
goto, and there is no reason to disallow them for these other ops.
This can also come in handy for certain types of code generators.

In the process of modifying pp functions to accept arbitrary labels,
I noticed that the label and loop-popping code was identical in three
functions, so I moved it out into a separate static function, to make
the changes easier.

I also had to reorder newLOOPEX significantly, because code under the
goto branch needed to a apply to last, and vice versa.  Using multiple
gotos to switch between the branches created too much of a mess.

I also eliminated the use of SP from pp_last, to avoid copying the
value back and forth between SP and PL_stack_sp.

1 files changed, 23 insertions, 19 deletions

diff --git a/op.c b/op.c
index 8a457350f6..d24ea4ddfa 100644
--- a/op.c
+++ b/op.c
@@ -6385,37 +6385,41 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label)
 
     if (type != OP_GOTO) {
 	/* "last()" means "last" */
-	if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS))
+	if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS)) {
 	    o = newOP(type, OPf_SPECIAL);
-	else {
-	  const_label:
-	    o = newPVOP(type,
-                        label->op_type == OP_CONST
-                            ? SvUTF8(((SVOP*)label)->op_sv)
-                            : 0,
-                        savesharedpv(label->op_type == OP_CONST
-				? SvPV_nolen_const(((SVOP*)label)->op_sv)
-				: ""));
+	    goto free_label;
 	}
-#ifdef PERL_MAD
-	op_getmad(label,o,'L');
-#else
-	op_free(label);
-#endif
     }
     else {
 	/* Check whether it's going to be a goto &function */
 	if (label->op_type == OP_ENTERSUB
 		&& !(label->op_flags & OPf_STACKED))
 	    label = newUNOP(OP_REFGEN, 0, op_lvalue(label, OP_REFGEN));
-	else if (label->op_type == OP_CONST) {
+    }
+
+    /* Check for a constant argument */
+    if (label->op_type == OP_CONST) {
 	    SV * const sv = ((SVOP *)label)->op_sv;
 	    STRLEN l;
 	    const char *s = SvPV_const(sv,l);
-	    if (l == strlen(s)) goto const_label;
-	}
-	o = newUNOP(type, OPf_STACKED, label);
+	    if (l == strlen(s)) {
+		o = newPVOP(type,
+			    SvUTF8(((SVOP*)label)->op_sv),
+			    savesharedpv(
+				SvPV_nolen_const(((SVOP*)label)->op_sv)));
+	      free_label:
+#ifdef PERL_MAD
+		op_getmad(label,o,'L');
+#else
+		op_free(label);
+#endif
+		label = NULL;
+	    }
     }
+    
+    /* If we still have a label op, we need to create a stacked unop. */
+    if (label) o = newUNOP(type, OPf_STACKED, label);
+
     PL_hints |= HINT_BLOCK_SCOPE;
     return o;
 }