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);
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);
}
};
STATIC I32
-S_dopoptolabel(pTHX_ const char *label)
+S_dopoptolabel(pTHX_ const char *label, STRLEN len, U32 flags)
{
dVAR;
register I32 i;
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)
case CXt_LOOP_FOR:
case CXt_LOOP_PLAIN:
{
- const char *cx_label = CxLABEL(cx);
- if (!cx_label || strNE(label, cx_label) ) {
+ STRLEN cx_label_len = 0;
+ U32 cx_label_flags = 0;
+ const char *cx_label = CxLABEL_len_flags(cx, &cx_label_len, &cx_label_flags);
+ if (!cx_label || !(
+ ( (cx_label_flags & SVf_UTF8) != (flags & SVf_UTF8) ) ?
+ (flags & SVf_UTF8)
+ ? (bytes_cmp_utf8(
+ (const U8*)cx_label, cx_label_len,
+ (const U8*)label, len) == 0)
+ : (bytes_cmp_utf8(
+ (const U8*)label, len,
+ (const U8*)cx_label, cx_label_len) == 0)
+ : (len == cx_label_len && ((cx_label == label)
+ || memEQ(cx_label, label, len))) )) {
DEBUG_l(Perl_deb(aTHX_ "(poptolabel(): skipping label at cx=%ld %s)\n",
(long)i, cx_label));
continue;
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)
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");
retop = cx->blk_sub.retop;
break;
default:
- DIE(aTHX_ "panic: return");
+ DIE(aTHX_ "panic: return, type=%u", (unsigned) CxTYPE(cx));
}
TAINT_NOT;
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);
SvREFCNT_dec(sv);
}
}
- else if (SvTEMP(*SP) && SvREFCNT(*SP) == 1) {
+ else if (SvTEMP(*SP) && SvREFCNT(*SP) == 1
+ && !SvMAGICAL(*SP)) {
*++newsp = *SP;
}
else
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 */
}
DIE(aTHX_ "Can't \"last\" outside a loop block");
}
else {
- cxix = dopoptolabel(cPVOP->op_pv);
+ cxix = dopoptolabel(cPVOP->op_pv, strlen(cPVOP->op_pv),
+ (cPVOP->op_private & OPpPV_IS_UTF8) ? SVf_UTF8 : 0);
if (cxix < 0)
- DIE(aTHX_ "Label not found for \"last %s\"", cPVOP->op_pv);
+ DIE(aTHX_ "Label not found for \"last %"SVf"\"",
+ SVfARG(newSVpvn_flags(cPVOP->op_pv,
+ strlen(cPVOP->op_pv),
+ ((cPVOP->op_private & OPpPV_IS_UTF8)
+ ? SVf_UTF8 : 0) | SVs_TEMP)));
}
if (cxix < cxstack_ix)
dounwind(cxix);
nextop = cx->blk_sub.retop;
break;
default:
- DIE(aTHX_ "panic: last");
+ DIE(aTHX_ "panic: last, type=%u", (unsigned) CxTYPE(cx));
}
TAINT_NOT;
DIE(aTHX_ "Can't \"next\" outside a loop block");
}
else {
- cxix = dopoptolabel(cPVOP->op_pv);
- if (cxix < 0)
- DIE(aTHX_ "Label not found for \"next %s\"", cPVOP->op_pv);
+ cxix = dopoptolabel(cPVOP->op_pv, strlen(cPVOP->op_pv),
+ (cPVOP->op_private & OPpPV_IS_UTF8) ? SVf_UTF8 : 0);
+ if (cxix < 0)
+ DIE(aTHX_ "Label not found for \"next %"SVf"\"",
+ SVfARG(newSVpvn_flags(cPVOP->op_pv,
+ strlen(cPVOP->op_pv),
+ ((cPVOP->op_private & OPpPV_IS_UTF8)
+ ? SVf_UTF8 : 0) | SVs_TEMP)));
}
if (cxix < cxstack_ix)
dounwind(cxix);
DIE(aTHX_ "Can't \"redo\" outside a loop block");
}
else {
- cxix = dopoptolabel(cPVOP->op_pv);
- if (cxix < 0)
- DIE(aTHX_ "Label not found for \"redo %s\"", cPVOP->op_pv);
+ cxix = dopoptolabel(cPVOP->op_pv, strlen(cPVOP->op_pv),
+ (cPVOP->op_private & OPpPV_IS_UTF8) ? SVf_UTF8 : 0);
+ if (cxix < 0)
+ DIE(aTHX_ "Label not found for \"redo %"SVf"\"",
+ SVfARG(newSVpvn_flags(cPVOP->op_pv,
+ strlen(cPVOP->op_pv),
+ ((cPVOP->op_private & OPpPV_IS_UTF8)
+ ? SVf_UTF8 : 0) | SVs_TEMP)));
}
if (cxix < cxstack_ix)
dounwind(cxix);
}
STATIC OP *
-S_dofindlabel(pTHX_ OP *o, const char *label, OP **opstack, OP **oplimit)
+S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, U32 flags, OP **opstack, OP **oplimit)
{
dVAR;
OP **ops = opstack;
/* First try all the kids at this level, since that's likeliest. */
for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) {
- const char *kid_label = CopLABEL(kCOP);
- if (kid_label && strEQ(kid_label, label))
+ STRLEN kid_label_len;
+ U32 kid_label_flags;
+ const char *kid_label = CopLABEL_len_flags(kCOP,
+ &kid_label_len, &kid_label_flags);
+ if (kid_label && (
+ ( (kid_label_flags & SVf_UTF8) != (flags & SVf_UTF8) ) ?
+ (flags & SVf_UTF8)
+ ? (bytes_cmp_utf8(
+ (const U8*)kid_label, kid_label_len,
+ (const U8*)label, len) == 0)
+ : (bytes_cmp_utf8(
+ (const U8*)label, len,
+ (const U8*)kid_label, kid_label_len) == 0)
+ : ( len == kid_label_len && ((kid_label == label)
+ || memEQ(kid_label, label, len)))))
return kid;
}
}
else
*ops++ = kid;
}
- if ((o = dofindlabel(kid, label, ops, oplimit)))
+ if ((o = dofindlabel(kid, label, len, flags, ops, oplimit)))
return o;
}
}
#define GOTO_DEPTH 64
OP *enterops[GOTO_DEPTH];
const char *label = NULL;
+ STRLEN label_len = 0;
+ U32 label_flags = 0;
const bool do_dump = (PL_op->op_type == OP_DUMP);
static const char must_have_label[] = "goto must have label";
/* 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))
}
}
else {
- label = SvPV_nolen_const(sv);
+ label = SvPV_const(sv, label_len);
+ label_flags = SvUTF8(sv);
if (!(do_dump || *label))
DIE(aTHX_ must_have_label);
}
if (! do_dump)
DIE(aTHX_ must_have_label);
}
- else
- label = cPVOP->op_pv;
+ else {
+ label = cPVOP->op_pv;
+ label_flags = (cPVOP->op_private & OPpPV_IS_UTF8) ? SVf_UTF8 : 0;
+ label_len = strlen(label);
+ if (!(do_dump || *label)) DIE(aTHX_ must_have_label);
+ }
PERL_ASYNC_CHECK();
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;
}
if (gotoprobe) {
- retop = dofindlabel(gotoprobe, label,
+ retop = dofindlabel(gotoprobe, label, label_len, label_flags,
enterops, enterops + GOTO_DEPTH);
if (retop)
break;
gotoprobe->op_sibling->op_type == OP_UNSTACK &&
gotoprobe->op_sibling->op_sibling) {
retop = dofindlabel(gotoprobe->op_sibling->op_sibling,
- label, enterops, enterops + GOTO_DEPTH);
+ label, label_len, label_flags, enterops,
+ enterops + GOTO_DEPTH);
if (retop)
break;
}
PL_lastgotoprobe = gotoprobe;
}
if (!retop)
- DIE(aTHX_ "Can't find label %s", label);
+ DIE(aTHX_ "Can't find label %"SVf,
+ SVfARG(newSVpvn_flags(label, label_len,
+ SVs_TEMP | label_flags)));
/* if we're leaving an eval, check before we pop any frames
that we're not going to punt, otherwise the error
* pushes undef (also croaks if startop != NULL).
*/
-/* This function is called from three places, sv_compile_2op, pp_return
+/* This function is called from three places, sv_compile_2op, pp_require
* and pp_entereval. These can be distinguished as follows:
* sv_compile_2op - startop is non-null
- * pp_require - startop is null; in_require is true
- * pp_entereval - stortop is null; in_require is false
+ * pp_require - startop is null; saveop is not entereval
+ * pp_entereval - startop is null; saveop is entereval
*/
STATIC bool
CLEAR_ERRSV();
if (!startop) {
+ bool clear_hints = saveop->op_type != OP_ENTEREVAL;
SAVEHINTS();
- if (in_require) {
+ if (clear_hints) {
PL_hints = 0;
hv_clear(GvHV(PL_hintgv));
}
}
}
SAVECOMPILEWARNINGS();
- if (in_require) {
+ if (clear_hints) {
if (PL_dowarn & G_WARN_ALL_ON)
PL_compiling.cop_warnings = pWARN_ALL ;
else if (PL_dowarn & G_WARN_ALL_OFF)
yystatus = (!in_require && CATCH_GET) ? S_try_yyparse(aTHX_ GRAMPROG) : yyparse(GRAMPROG);
- if (!startop && yystatus != 3) LEAVE_with_name("evalcomp");
-
if (yystatus || PL_parser->error_count || !PL_eval_root) {
SV **newsp; /* Used by POPBLOCK. */
PERL_CONTEXT *cx;
POPEVAL(cx);
namesv = cx->blk_eval.old_namesv;
}
+ /* POPBLOCK renders LEAVE_with_name("evalcomp") unnecessary. */
LEAVE_with_name("eval"); /* pp_entereval knows about this LEAVE. */
}
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;
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;
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);
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) {
https://perl5.git.perl.org / perl5.git / blobdiff