* Then he heard Merry change the note, and up went the Horn-cry of Buckland,
* shaking the air.
*
- * Awake! Awake! Fear, Fire, Foes! Awake!
- * Fire, Foes! Awake!
+ * Awake! Awake! Fear, Fire, Foes! Awake!
+ * Fire, Foes! Awake!
+ *
+ * [p.1007 of _The Lord of the Rings_, VI/viii: "The Scouring of the Shire"]
*/
/* This file contains 'hot' pp ("push/pop") functions that
goto just_say_no;
}
else {
+ SV * const ofs = GvSV(PL_ofsgv); /* $, */
MARK++;
- if (PL_ofs_sv && SvOK(PL_ofs_sv)) {
+ if (ofs && (SvGMAGICAL(ofs) || SvOK(ofs))) {
while (MARK <= SP) {
if (!do_print(*MARK, fp))
break;
MARK++;
if (MARK <= SP) {
- if (!do_print(PL_ofs_sv, fp)) { /* $, */
+ /* don't use 'ofs' here - it may be invalidated by magic callbacks */
+ if (!do_print(GvSV(PL_ofsgv), fp)) {
MARK--;
break;
}
I32 gimme = OP_GIMME(PL_op, -1);
if (gimme == -1) {
- if (cxstack_ix >= 0)
- gimme = cxstack[cxstack_ix].blk_gimme;
- else
+ if (cxstack_ix >= 0) {
+ /* If this flag is set, we're just inside a return, so we should
+ * store the caller's context */
+ gimme = (PL_op->op_flags & OPf_SPECIAL)
+ ? block_gimme()
+ : cxstack[cxstack_ix].blk_gimme;
+ } else
gimme = G_SCALAR;
}
const U32 defer = PL_op->op_private & OPpLVAL_DEFER;
SV *sv;
const U32 hash = (SvIsCOW_shared_hash(keysv)) ? SvSHARED_HASH(keysv) : 0;
- I32 preeminent = 0;
+ const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
+ bool preeminent = TRUE;
if (SvTYPE(hv) != SVt_PVHV)
RETPUSHUNDEF;
- if (PL_op->op_private & OPpLVAL_INTRO) {
+ if (localizing) {
MAGIC *mg;
HV *stash;
- /* does the element we're localizing already exist? */
- preeminent = /* can we determine whether it exists? */
- ( !SvRMAGICAL(hv)
- || mg_find((const SV *)hv, PERL_MAGIC_env)
- || ( (mg = mg_find((const SV *)hv, PERL_MAGIC_tied))
- /* Try to preserve the existenceness of a tied hash
- * element by using EXISTS and DELETE if possible.
- * Fallback to FETCH and STORE otherwise */
- && (stash = SvSTASH(SvRV(SvTIED_obj(MUTABLE_SV(hv), mg))))
- && gv_fetchmethod_autoload(stash, "EXISTS", TRUE)
- && gv_fetchmethod_autoload(stash, "DELETE", TRUE)
- )
- ) ? hv_exists_ent(hv, keysv, 0) : 1;
+
+ /* If we can determine whether the element exist,
+ * Try to preserve the existenceness of a tied hash
+ * element by using EXISTS and DELETE if possible.
+ * Fallback to FETCH and STORE otherwise. */
+ if (SvCANEXISTDELETE(hv) || mg_find((const SV *)hv, PERL_MAGIC_env))
+ preeminent = hv_exists_ent(hv, keysv, 0);
}
+
he = hv_fetch_ent(hv, keysv, lval && !defer, hash);
svp = he ? &HeVAL(he) : NULL;
if (lval) {
PUSHs(lv);
RETURN;
}
- if (PL_op->op_private & OPpLVAL_INTRO) {
+ if (localizing) {
if (HvNAME_get(hv) && isGV(*svp))
save_gp(MUTABLE_GV(*svp), !(PL_op->op_flags & OPf_SPECIAL));
- else {
- if (!preeminent) {
- STRLEN keylen;
- const char * const key = SvPV_const(keysv, keylen);
- SAVEDELETE(hv, savepvn(key,keylen),
- SvUTF8(keysv) ? -(I32)keylen : (I32)keylen);
- } else
- save_helem(hv, keysv, svp);
- }
+ else if (preeminent)
+ save_helem_flags(hv, keysv, svp,
+ (PL_op->op_flags & OPf_SPECIAL) ? 0 : SAVEf_SETMAGIC);
+ else
+ SAVEHDELETE(hv, keysv);
}
else if (PL_op->op_private & OPpDEREF)
vivify_ref(*svp, PL_op->op_private & OPpDEREF);
POPBLOCK(cx,newpm);
- gimme = OP_GIMME(PL_op, -1);
- if (gimme == -1) {
- if (cxstack_ix >= 0)
- gimme = cxstack[cxstack_ix].blk_gimme;
- else
- gimme = G_SCALAR;
- }
+ gimme = OP_GIMME(PL_op, (cxstack_ix >= 0) ? gimme : G_SCALAR);
TAINT_NOT;
if (gimme == G_VOID)
if (PL_op->op_private & OPpGREP_LEX)
PAD_SVl(PL_op->op_targ) = src;
else
- DEFSV = src;
+ DEFSV_set(src);
RETURNOP(cLOGOP->op_other);
}
Perl_get_db_sub(aTHX_ &sv, cv);
if (CvISXSUB(cv))
PL_curcopdb = PL_curcop;
- cv = GvCV(PL_DBsub);
+ if (CvLVALUE(cv)) {
+ /* check for lsub that handles lvalue subroutines */
+ cv = GvCV(gv_HVadd(gv_fetchpvs("DB::lsub", GV_ADDMULTI, SVt_PVHV)));
+ /* if lsub not found then fall back to DB::sub */
+ if (!cv) cv = GvCV(PL_DBsub);
+ } else {
+ cv = GvCV(PL_DBsub);
+ }
if (!cv || (!CvXSUB(cv) && !CvSTART(cv)))
DIE(aTHX_ "No DB::sub routine defined");
AV *const av = MUTABLE_AV(POPs);
const U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
const U32 defer = (PL_op->op_private & OPpLVAL_DEFER) && (elem > av_len(av));
+ const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
+ bool preeminent = TRUE;
SV *sv;
if (SvROK(elemsv) && !SvGAMAGIC(elemsv) && ckWARN(WARN_MISC))
elem -= CopARYBASE_get(PL_curcop);
if (SvTYPE(av) != SVt_PVAV)
RETPUSHUNDEF;
+
+ if (localizing) {
+ MAGIC *mg;
+ HV *stash;
+
+ /* If we can determine whether the element exist,
+ * Try to preserve the existenceness of a tied array
+ * element by using EXISTS and DELETE if possible.
+ * Fallback to FETCH and STORE otherwise. */
+ if (SvCANEXISTDELETE(av))
+ preeminent = av_exists(av, elem);
+ }
+
svp = av_fetch(av, elem, lval && !defer);
if (lval) {
#ifdef PERL_MALLOC_WRAP
PUSHs(lv);
RETURN;
}
- if (PL_op->op_private & OPpLVAL_INTRO)
- save_aelem(av, elem, svp);
+ if (localizing) {
+ if (preeminent)
+ save_aelem(av, elem, svp);
+ else
+ SAVEADELETE(av, elem);
+ }
else if (PL_op->op_private & OPpDEREF)
vivify_ref(*svp, PL_op->op_private & OPpDEREF);
}
SV* ob;
GV* gv;
HV* stash;
- STRLEN namelen;
const char* packname = NULL;
SV *packsv = NULL;
STRLEN packlen;
- const char * const name = SvPV_const(meth, namelen);
SV * const sv = *(PL_stack_base + TOPMARK + 1);
PERL_ARGS_ASSERT_METHOD_COMMON;
if (!sv)
- Perl_croak(aTHX_ "Can't call method \"%s\" on an undefined value", name);
+ Perl_croak(aTHX_ "Can't call method \"%"SVf"\" on an undefined value",
+ SVfARG(meth));
SvGETMAGIC(sv);
if (SvROK(sv))
: !isIDFIRST(*packname)
))
{
- Perl_croak(aTHX_ "Can't call method \"%s\" %s", name,
+ Perl_croak(aTHX_ "Can't call method \"%"SVf"\" %s",
+ SVfARG(meth),
SvOK(sv) ? "without a package or object reference"
: "on an undefined value");
}
&& (ob = MUTABLE_SV(GvIO((const GV *)ob)))
&& SvOBJECT(ob))))
{
+ const char * const name = SvPV_nolen_const(meth);
Perl_croak(aTHX_ "Can't call method \"%s\" on unblessed reference",
(SvSCREAM(meth) && strEQ(name,"isa")) ? "DOES" :
name);
}
}
- gv = gv_fetchmethod_flags(stash ? stash : MUTABLE_HV(packsv), name,
+ gv = gv_fetchmethod_flags(stash ? stash : MUTABLE_HV(packsv),
+ SvPV_nolen_const(meth),
GV_AUTOLOAD | GV_CROAK);
assert(gv);