X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/15d9c083b08647e489d279a1059b4f14a3df187b..77649ca9d82a2e8cc65a4fcc0db2c41ca4daa6ce:/pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index eb74840..a679f41 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -130,6 +130,13 @@ PP(pp_regcomp)
 	       sv_setsv(tmpstr, sv);
 	       continue;
 	    }
+
+	    if (SvROK(msv) && SvTYPE(SvRV(msv)) == SVt_REGEXP) {
+		msv = SvRV(msv);
+		PL_reginterp_cnt +=
+		    RX_SEEN_EVALS((REGEXP *)MUTABLE_PTR(msv));
+	    }
+
 	    sv_catsv_nomg(tmpstr, msv);
 	}
     	SvSETMAGIC(tmpstr);
@@ -214,19 +221,11 @@ PP(pp_regcomp)
 		const char *const p = SvPV(tmpstr, len);
 		tmpstr = newSVpvn_flags(p, len, SVs_TEMP);
 	    }
-	    else if (SvAMAGIC(tmpstr)) {
+	    else if (SvAMAGIC(tmpstr) || SvGMAGICAL(tmpstr)) {
 		/* make a copy to avoid extra stringifies */
 		tmpstr = newSVpvn_flags(t, len, SVs_TEMP | SvUTF8(tmpstr));
 	    }
 
-	    /* If it is gmagical, create a mortal copy, but without calling
-	       get-magic, as we have already done that. */
-	    if(SvGMAGICAL(tmpstr)) {
-		SV *mortalcopy = sv_newmortal();
-		sv_setsv_flags(mortalcopy, tmpstr, 0);
-		tmpstr = mortalcopy;
-	    }
-
 	    if (eng)
 	        PM_SETRE(pm, CALLREGCOMP_ENG(eng, tmpstr, pm_flags));
 	    else
@@ -336,11 +335,9 @@ PP(pp_substcont)
 		targ = dstr;
 	    }
 	    else {
-#ifdef PERL_OLD_COPY_ON_WRITE
 		if (SvIsCOW(targ)) {
 		    sv_force_normal_flags(targ, SV_COW_DROP_PV);
 		} else
-#endif
 		{
 		    SvPV_free(targ);
 		}
@@ -1404,6 +1401,7 @@ S_dopoptolabel(pTHX_ const char *label)
 	case CXt_FORMAT:
 	case CXt_EVAL:
 	case CXt_NULL:
+	    /* diag_listed_as: Exiting subroutine via %s */
 	    Perl_ck_warner(aTHX_ packWARN(WARN_EXITING), "Exiting %s via %s",
 			   context_name[CxTYPE(cx)], OP_NAME(PL_op));
 	    if (CxTYPE(cx) == CXt_NULL)
@@ -1541,6 +1539,7 @@ S_dopoptoloop(pTHX_ I32 startingblock)
 	case CXt_FORMAT:
 	case CXt_EVAL:
 	case CXt_NULL:
+	    /* diag_listed_as: Exiting subroutine via %s */
 	    Perl_ck_warner(aTHX_ packWARN(WARN_EXITING), "Exiting %s via %s",
 			   context_name[CxTYPE(cx)], OP_NAME(PL_op));
 	    if ((CxTYPE(cx)) == CXt_NULL)
@@ -2405,6 +2404,7 @@ S_return_lvalues(pTHX_ SV **mark, SV **sp, SV **newsp, I32 gimme,
 		    POPSUB(cx,sv);
 		    PL_curpm = newpm;
 		    LEAVESUB(sv);
+	       /* diag_listed_as: Can't return %s from lvalue subroutine */
 		    Perl_croak(aTHX_
 			"Can't return a %s from lvalue subroutine",
 			SvREADONLY(TOPs) ? "readonly value" : "temporary");
@@ -2494,7 +2494,7 @@ PP(pp_return)
 	retop = cx->blk_sub.retop;
 	break;
     default:
-	DIE(aTHX_ "panic: return");
+	DIE(aTHX_ "panic: return, type=%u", (unsigned) CxTYPE(cx));
     }
 
     TAINT_NOT;
@@ -2504,7 +2504,8 @@ PP(pp_return)
 	if (MARK < SP) {
 	    if (popsub2) {
 		if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) {
-		    if (SvTEMP(TOPs) && SvREFCNT(TOPs) == 1) {
+		    if (SvTEMP(TOPs) && SvREFCNT(TOPs) == 1
+			 && !SvMAGICAL(TOPs)) {
 			*++newsp = SvREFCNT_inc(*SP);
 			FREETMPS;
 			sv_2mortal(*newsp);
@@ -2516,7 +2517,8 @@ PP(pp_return)
 			SvREFCNT_dec(sv);
 		    }
 		}
-		else if (SvTEMP(*SP) && SvREFCNT(*SP) == 1) {
+		else if (SvTEMP(*SP) && SvREFCNT(*SP) == 1
+			  && !SvMAGICAL(*SP)) {
 		    *++newsp = *SP;
 		}
 		else
@@ -2531,6 +2533,7 @@ PP(pp_return)
       else if (gimme == G_ARRAY) {
 	while (++MARK <= SP) {
 	    *++newsp = popsub2 && SvTEMP(*MARK) && SvREFCNT(*MARK) == 1
+			       && !SvGMAGICAL(*MARK)
 			? *MARK : sv_mortalcopy(*MARK);
 	    TAINT_NOT;		/* Each item is independent */
 	}
@@ -2638,7 +2641,7 @@ PP(pp_last)
 	nextop = cx->blk_sub.retop;
 	break;
     default:
-	DIE(aTHX_ "panic: last");
+	DIE(aTHX_ "panic: last, type=%u", (unsigned) CxTYPE(cx));
     }
 
     TAINT_NOT;
@@ -2847,8 +2850,10 @@ PP(pp_goto)
 	    /* ban goto in eval: see <20050521150056.GC20213@iabyn.com> */
 	    if (CxTYPE(cx) == CXt_EVAL) {
 		if (CxREALEVAL(cx))
+		/* diag_listed_as: Can't goto subroutine from an eval-%s */
 		    DIE(aTHX_ "Can't goto subroutine from an eval-string");
 		else
+		/* diag_listed_as: Can't goto subroutine from an eval-%s */
 		    DIE(aTHX_ "Can't goto subroutine from an eval-block");
 	    }
 	    else if (CxMULTICALL(cx))
@@ -2887,13 +2892,26 @@ PP(pp_goto)
 	    oldsave = PL_scopestack[PL_scopestack_ix - 1];
 	    LEAVE_SCOPE(oldsave);
 
+	    /* A destructor called during LEAVE_SCOPE could have undefined
+	     * our precious cv.  See bug #99850. */
+	    if (!CvROOT(cv) && !CvXSUB(cv)) {
+		const GV * const gv = CvGV(cv);
+		if (gv) {
+		    SV * const tmpstr = sv_newmortal();
+		    gv_efullname3(tmpstr, gv, NULL);
+		    DIE(aTHX_ "Goto undefined subroutine &%"SVf"",
+			       SVfARG(tmpstr));
+		}
+		DIE(aTHX_ "Goto undefined subroutine");
+	    }
+
 	    /* Now do some callish stuff. */
 	    SAVETMPS;
 	    SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
 	    if (CvISXSUB(cv)) {
 		OP* const retop = cx->blk_sub.retop;
-		SV **newsp __attribute__unused__;
-		I32 gimme __attribute__unused__;
+		SV **newsp PERL_UNUSED_DECL;
+		I32 gimme PERL_UNUSED_DECL;
 		if (reified) {
 		    I32 index;
 		    for (index=0; index<items; index++)
@@ -3047,7 +3065,8 @@ PP(pp_goto)
 		DIE(aTHX_ "Can't \"goto\" out of a pseudo block");
 	    default:
 		if (ix)
-		    DIE(aTHX_ "panic: goto");
+		    DIE(aTHX_ "panic: goto, type=%u, ix=%ld",
+			CxTYPE(cx), (long) ix);
 		gotoprobe = PL_main_root;
 		break;
 	    }
@@ -3360,9 +3379,9 @@ Perl_sv_compile_2op_is_broken(pTHX_ SV *sv, OP **startop, const char *code,
     CATCH_SET(TRUE);
 
     if (runtime)
-	(void) doeval(G_SCALAR, startop, runcv, PL_curcop->cop_seq);
+	(void) doeval(G_SCALAR, startop, runcv, PL_curcop->cop_seq, NULL);
     else
-	(void) doeval(G_SCALAR, startop, PL_compcv, PL_cop_seqmax);
+	(void) doeval(G_SCALAR, startop, PL_compcv, PL_cop_seqmax, NULL);
     CATCH_SET(need_catch);
     POPBLOCK(cx,PL_curpm);
     POPEVAL(cx);
@@ -3418,7 +3437,7 @@ Perl_find_runcv(pTHX_ U32 *db_seqp)
 		return cv;
 	    }
 	    else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
-		return PL_compcv;
+		return cx->blk_eval.cv;
 	}
     }
     return PL_main_cv;
@@ -3463,13 +3482,22 @@ S_try_yyparse(pTHX_ int gramtype)
  * pushes undef (also croaks if startop != NULL).
  */
 
+/* This function is called from three places, sv_compile_2op, pp_return
+ * and pp_entereval.  These can be distinguished as follows:
+ *    sv_compile_2op - startop is non-null
+ *    pp_require     - startop is null; saveop is not entereval
+ *    pp_entereval   - startop is null; saveop is entereval
+ */
+
 STATIC bool
-S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
+S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq, HV *hh)
 {
     dVAR; dSP;
     OP * const saveop = PL_op;
+    COP * const oldcurcop = PL_curcop;
     bool in_require = (saveop && saveop->op_type == OP_REQUIRE);
     int yystatus;
+    CV *evalcv;
 
     PL_in_eval = (in_require
 		  ? (EVAL_INREQUIRE | (PL_in_eval & EVAL_INEVAL))
@@ -3477,24 +3505,23 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
 
     PUSHMARK(SP);
 
-    SAVESPTR(PL_compcv);
-    PL_compcv = MUTABLE_CV(newSV_type(SVt_PVCV));
-    CvEVAL_on(PL_compcv);
+    evalcv = MUTABLE_CV(newSV_type(SVt_PVCV));
+    CvEVAL_on(evalcv);
     assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL);
-    cxstack[cxstack_ix].blk_eval.cv = PL_compcv;
+    cxstack[cxstack_ix].blk_eval.cv = evalcv;
     cxstack[cxstack_ix].blk_gimme = gimme;
 
-    CvOUTSIDE_SEQ(PL_compcv) = seq;
-    CvOUTSIDE(PL_compcv) = MUTABLE_CV(SvREFCNT_inc_simple(outside));
+    CvOUTSIDE_SEQ(evalcv) = seq;
+    CvOUTSIDE(evalcv) = MUTABLE_CV(SvREFCNT_inc_simple(outside));
 
     /* set up a scratch pad */
 
-    CvPADLIST(PL_compcv) = pad_new(padnew_SAVE);
+    CvPADLIST(evalcv) = pad_new(padnew_SAVE);
     PL_op = NULL; /* avoid PL_op and PL_curpad referring to different CVs */
 
 
     if (!PL_madskills)
-	SAVEMORTALIZESV(PL_compcv);	/* must remain until end of current statement */
+	SAVEMORTALIZESV(evalcv);	/* must remain until end of current statement */
 
     /* make sure we compile in the right package */
 
@@ -3515,6 +3542,10 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
     PL_madskills = 0;
 #endif
 
+    if (!startop) ENTER_with_name("evalcomp");
+    SAVESPTR(PL_compcv);
+    PL_compcv = evalcv;
+
     /* try to compile it */
 
     PL_eval_root = NULL;
@@ -3524,6 +3555,49 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
     else
 	CLEAR_ERRSV();
 
+    if (!startop) {
+	bool clear_hints = saveop->op_type != OP_ENTEREVAL;
+	SAVEHINTS();
+	if (clear_hints) {
+	    PL_hints = 0;
+	    hv_clear(GvHV(PL_hintgv));
+	}
+	else {
+	    PL_hints = saveop->op_private & OPpEVAL_COPHH
+			 ? oldcurcop->cop_hints : saveop->op_targ;
+	    if (hh) {
+		/* SAVEHINTS created a new HV in PL_hintgv, which we need to GC */
+		SvREFCNT_dec(GvHV(PL_hintgv));
+		GvHV(PL_hintgv) = hh;
+	    }
+	}
+	SAVECOMPILEWARNINGS();
+	if (clear_hints) {
+	    if (PL_dowarn & G_WARN_ALL_ON)
+	        PL_compiling.cop_warnings = pWARN_ALL ;
+	    else if (PL_dowarn & G_WARN_ALL_OFF)
+	        PL_compiling.cop_warnings = pWARN_NONE ;
+	    else
+	        PL_compiling.cop_warnings = pWARN_STD ;
+	}
+	else {
+	    PL_compiling.cop_warnings =
+		DUP_WARNINGS(oldcurcop->cop_warnings);
+	    cophh_free(CopHINTHASH_get(&PL_compiling));
+	    if (Perl_cop_fetch_label(aTHX_ oldcurcop, NULL, NULL)) {
+		/* The label, if present, is the first entry on the chain. So rather
+		   than writing a blank label in front of it (which involves an
+		   allocation), just use the next entry in the chain.  */
+		PL_compiling.cop_hints_hash
+		    = cophh_copy(oldcurcop->cop_hints_hash->refcounted_he_next);
+		/* Check the assumption that this removed the label.  */
+		assert(Perl_cop_fetch_label(aTHX_ &PL_compiling, NULL, NULL) == NULL);
+	    }
+	    else
+		PL_compiling.cop_hints_hash = cophh_copy(oldcurcop->cop_hints_hash);
+	}
+    }
+
     CALL_BLOCK_HOOKS(bhk_eval, saveop);
 
     /* note that yyparse() may raise an exception, e.g. C<BEGIN{die}>,
@@ -3556,9 +3630,9 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
 		POPEVAL(cx);
 		namesv = cx->blk_eval.old_namesv;
 	    }
-	}
-	if (yystatus != 3)
+	    /* POPBLOCK renders LEAVE_with_name("evalcomp") unnecessary. */
 	    LEAVE_with_name("eval"); /* pp_entereval knows about this LEAVE.  */
+	}
 
 	if (in_require) {
 	    if (!cx) {
@@ -3592,10 +3666,11 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
 	        sv_setpvs(ERRSV, "Compilation error");
 	    }
 	}
-	PUSHs(&PL_sv_undef);
+	if (gimme != G_ARRAY) PUSHs(&PL_sv_undef);
 	PUTBACK;
 	return FALSE;
     }
+    else if (!startop) LEAVE_with_name("evalcomp");
     CopLINE_set(&PL_compiling, 0);
     if (startop) {
 	*startop = PL_eval_root;
@@ -3624,7 +3699,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
 
     /* compiled okay, so do it */
 
-    CvDEPTH(PL_compcv) = 1;
+    CvDEPTH(evalcv) = 1;
     SP = PL_stack_base + POPMARK;		/* pop original mark */
     PL_op = saveop;			/* The caller may need it. */
     PL_parser->lex_state = LEX_NOTPARSING;	/* $^S needs this. */
@@ -4060,18 +4135,6 @@ PP(pp_require)
     CopFILE_set(&PL_compiling, tryname);
     lex_start(NULL, tryrsfp, 0);
 
-    SAVEHINTS();
-    PL_hints = 0;
-    hv_clear(GvHV(PL_hintgv));
-
-    SAVECOMPILEWARNINGS();
-    if (PL_dowarn & G_WARN_ALL_ON)
-        PL_compiling.cop_warnings = pWARN_ALL ;
-    else if (PL_dowarn & G_WARN_ALL_OFF)
-        PL_compiling.cop_warnings = pWARN_NONE ;
-    else
-        PL_compiling.cop_warnings = pWARN_STD ;
-
     if (filter_sub || filter_cache) {
 	/* We can use the SvPV of the filter PVIO itself as our cache, rather
 	   than hanging another SV from it. In turn, filter_add() optionally
@@ -4097,7 +4160,7 @@ PP(pp_require)
     encoding = PL_encoding;
     PL_encoding = NULL;
 
-    if (doeval(gimme, NULL, NULL, PL_curcop->cop_seq))
+    if (doeval(gimme, NULL, NULL, PL_curcop->cop_seq, NULL))
 	op = DOCATCH(PL_eval_start);
     else
 	op = PL_op->op_next;
@@ -4133,12 +4196,20 @@ PP(pp_entereval)
     char *tmpbuf = tbuf;
     STRLEN len;
     CV* runcv;
-    U32 seq;
+    U32 seq, lex_flags = 0;
     HV *saved_hh = NULL;
+    const bool bytes = PL_op->op_private & OPpEVAL_BYTES;
 
     if (PL_op->op_private & OPpEVAL_HAS_HH) {
 	saved_hh = MUTABLE_HV(SvREFCNT_inc(POPs));
     }
+    else if (PL_hints & HINT_LOCALIZE_HH || (
+	        PL_op->op_private & OPpEVAL_COPHH
+	     && PL_curcop->cop_hints & HINT_LOCALIZE_HH
+	    )) {
+	saved_hh = cop_hints_2hv(PL_curcop, 0);
+	hv_magic(saved_hh, NULL, PERL_MAGIC_hints);
+    }
     sv = POPs;
     if (!SvPOK(sv)) {
 	/* make sure we've got a plain PV (no overload etc) before testing
@@ -4148,13 +4219,29 @@ PP(pp_entereval)
 	const char * const p = SvPV_const(sv, len);
 
 	sv = newSVpvn_flags(p, len, SVs_TEMP | SvUTF8(sv));
+	lex_flags |= LEX_START_COPIED;
+
+	if (bytes && SvUTF8(sv))
+	    SvPVbyte_force(sv, len);
+    }
+    else if (bytes && SvUTF8(sv)) {
+	/* Don't modify someone else's scalar */
+	STRLEN len;
+	sv = newSVsv(sv);
+	(void)sv_2mortal(sv);
+	SvPVbyte_force(sv,len);
+	lex_flags |= LEX_START_COPIED;
     }
 
     TAINT_IF(SvTAINTED(sv));
     TAINT_PROPER("eval");
 
     ENTER_with_name("eval");
-    lex_start(sv, NULL, LEX_START_SAME_FILTER);
+    lex_start(sv, NULL, lex_flags | (PL_op->op_private & OPpEVAL_UNICODE
+			   ? LEX_IGNORE_UTF8_HINTS
+			   : bytes ? LEX_EVALBYTES : LEX_START_SAME_FILTER
+			)
+	     );
     SAVETMPS;
 
     /* switch to eval mode */
@@ -4173,32 +4260,6 @@ PP(pp_entereval)
     CopFILE_set(&PL_compiling, tmpbuf+2);
     SAVECOPLINE(&PL_compiling);
     CopLINE_set(&PL_compiling, 1);
-    /* XXX For C<eval "...">s within BEGIN {} blocks, this ends up
-       deleting the eval's FILEGV from the stash before gv_check() runs
-       (i.e. before run-time proper). To work around the coredump that
-       ensues, we always turn GvMULTI_on for any globals that were
-       introduced within evals. See force_ident(). GSAR 96-10-12 */
-    SAVEHINTS();
-    PL_hints = PL_op->op_targ;
-    if (saved_hh) {
-	/* SAVEHINTS created a new HV in PL_hintgv, which we need to GC */
-	SvREFCNT_dec(GvHV(PL_hintgv));
-	GvHV(PL_hintgv) = saved_hh;
-    }
-    SAVECOMPILEWARNINGS();
-    PL_compiling.cop_warnings = DUP_WARNINGS(PL_curcop->cop_warnings);
-    cophh_free(CopHINTHASH_get(&PL_compiling));
-    if (Perl_cop_fetch_label(aTHX_ PL_curcop, NULL, NULL)) {
-	/* The label, if present, is the first entry on the chain. So rather
-	   than writing a blank label in front of it (which involves an
-	   allocation), just use the next entry in the chain.  */
-	PL_compiling.cop_hints_hash
-	    = cophh_copy(PL_curcop->cop_hints_hash->refcounted_he_next);
-	/* Check the assumption that this removed the label.  */
-	assert(Perl_cop_fetch_label(aTHX_ &PL_compiling, NULL, NULL) == NULL);
-    }
-    else
-	PL_compiling.cop_hints_hash = cophh_copy(PL_curcop->cop_hints_hash);
     /* special case: an eval '' executed within the DB package gets lexically
      * placed in the first non-DB CV rather than the current CV - this
      * allows the debugger to execute code, find lexicals etc, in the
@@ -4215,6 +4276,11 @@ PP(pp_entereval)
     if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
 	save_lines(CopFILEAV(&PL_compiling), PL_parser->linestr);
     else {
+	/* XXX For C<eval "...">s within BEGIN {} blocks, this ends up
+	   deleting the eval's FILEGV from the stash before gv_check() runs
+	   (i.e. before run-time proper). To work around the coredump that
+	   ensues, we always turn GvMULTI_on for any globals that were
+	   introduced within evals. See force_ident(). GSAR 96-10-12 */
 	char *const safestr = savepvn(tmpbuf, len);
 	SAVEDELETE(PL_defstash, safestr, len);
 	saved_delete = TRUE;
@@ -4222,7 +4288,7 @@ PP(pp_entereval)
     
     PUTBACK;
 
-    if (doeval(gimme, NULL, runcv, seq)) {
+    if (doeval(gimme, NULL, runcv, seq, saved_hh)) {
 	if (was != PL_breakable_sub_gen /* Some subs defined here. */
 	    ? (PERLDB_LINE || PERLDB_SAVESRC)
 	    :  PERLDB_SAVESRC_NOSUBS) {
@@ -4257,12 +4323,14 @@ PP(pp_leaveeval)
     const U8 save_flags = PL_op -> op_flags;
     I32 optype;
     SV *namesv;
+    CV *evalcv;
 
     PERL_ASYNC_CHECK();
     POPBLOCK(cx,newpm);
     POPEVAL(cx);
     namesv = cx->blk_eval.old_namesv;
     retop = cx->blk_eval.retop;
+    evalcv = cx->blk_eval.cv;
 
     TAINT_NOT;
     SP = adjust_stack_on_leave((gimme == G_VOID) ? SP : newsp, SP, newsp,
@@ -4270,9 +4338,9 @@ PP(pp_leaveeval)
     PL_curpm = newpm;	/* Don't pop $1 et al till now */
 
 #ifdef DEBUGGING
-    assert(CvDEPTH(PL_compcv) == 1);
+    assert(CvDEPTH(evalcv) == 1);
 #endif
-    CvDEPTH(PL_compcv) = 0;
+    CvDEPTH(evalcv) = 0;
 
     if (optype == OP_REQUIRE &&
 	!(gimme == G_SCALAR ? SvTRUE(*SP) : SP > newsp))
@@ -4494,7 +4562,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied)
 	DEBUG_M(Perl_deb(aTHX_ "    applying rule Any-Object\n"));
 	DEBUG_M(Perl_deb(aTHX_ "        attempting overload\n"));
 
-	tmpsv = amagic_call(d, e, smart_amg, 0);
+	tmpsv = amagic_call(d, e, smart_amg, AMGf_noleft);
 	if (tmpsv) {
 	    SPAGAIN;
 	    (void)POPs;
@@ -4973,7 +5041,9 @@ PP(pp_leavewhen)
 
     cxix = dopoptogiven(cxstack_ix);
     if (cxix < 0)
-	DIE(aTHX_ "Can't use when() outside a topicalizer");
+	/* diag_listed_as: Can't "when" outside a topicalizer */
+	DIE(aTHX_ "Can't \"%s\" outside a topicalizer",
+	           PL_op->op_flags & OPf_SPECIAL ? "default" : "when");
 
     POPBLOCK(cx,newpm);
     assert(CxTYPE(cx) == CXt_WHEN);
@@ -5416,14 +5486,11 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 	int count;
 
 	ENTER_with_name("call_filter_sub");
-	save_gp(PL_defgv, 0);
-	GvINTRO_off(PL_defgv);
-	SAVEGENERICSV(GvSV(PL_defgv));
+	SAVE_DEFSV;
 	SAVETMPS;
 	EXTEND(SP, 2);
 
 	DEFSV_set(upstream);
-	SvREFCNT_inc_simple_void_NN(upstream);
 	PUSHMARK(SP);
 	mPUSHi(0);
 	if (filter_state) {