gv = (GV*)*++MARK;
else
gv = PL_defoutgv;
- if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+ if (mg = SvTIED_mg((SV*)gv, 'q')) {
if (MARK == ORIGMARK) {
/* If using default handle then we need to make space to
* pass object as 1st arg, so move other args up ...
++SP;
}
PUSHMARK(MARK - 1);
- *MARK = mg->mg_obj;
+ *MARK = SvTIED_obj((SV*)gv, mg);
PUTBACK;
ENTER;
perl_call_method("PRINT", G_SCALAR);
* clobber a value on the right that's used later in the list.
*/
if (PL_op->op_private & OPpASSIGN_COMMON) {
+ EXTEND_MORTAL(lastrelem - firstrelem + 1);
for (relem = firstrelem; relem <= lastrelem; relem++) {
/*SUPPRESS 560*/
if (sv = *relem) {
}
}
}
- safebase = (((gimme == G_ARRAY) || global || !rx->nparens)
- && !PL_sawampersand);
- safebase = safebase ? 0 : REXEC_COPY_STR ;
+ safebase = ((gimme != G_ARRAY && !global && rx->nparens)
+ || SvTEMP(TARG) || PL_sawampersand)
+ ? REXEC_COPY_STR : 0;
if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
SAVEINT(PL_multiline);
PL_multiline = pm->op_pmflags & PMf_MULTILINE;
if (PL_screamfirst[BmRARE(rx->check_substr)] < 0)
goto nope;
- b = HOP((U8*)s, rx->check_offset_min);
+ b = (char*)HOP((U8*)s, rx->check_offset_min);
if (!(s = screaminstr(TARG, rx->check_substr, b - s, 0, &p, 0)))
goto nope;
goto yup;
if (s && rx->check_offset_max < s - t) {
++BmUSEFUL(rx->check_substr);
- s = HOP((U8*)s, -rx->check_offset_max);
+ s = (char*)HOP((U8*)s, -rx->check_offset_max);
}
else
s = t;
beginning of match, and the match is anchored at s. */
else if (!PL_multiline) { /* Anchored near beginning of string. */
I32 slen;
- char *b = HOP((U8*)s, rx->check_offset_min);
+ char *b = (char*)HOP((U8*)s, rx->check_offset_min);
if (*SvPVX(rx->check_substr) != *b
|| ((slen = SvCUR(rx->check_substr)) > 1
&& memNE(SvPVX(rx->check_substr), b, slen)))
I32 gimme = GIMME_V;
MAGIC *mg;
- if (SvRMAGICAL(PL_last_in_gv) && (mg = mg_find((SV*)PL_last_in_gv, 'q'))) {
+ if (mg = SvTIED_mg((SV*)PL_last_in_gv, 'q')) {
PUSHMARK(SP);
- XPUSHs(mg->mg_obj);
+ XPUSHs(SvTIED_obj((SV*)PL_last_in_gv, mg));
PUTBACK;
ENTER;
perl_call_method("READLINE", gimme);
IoFLAGS(io) |= IOf_START;
}
else if (type == OP_GLOB) {
- if (!do_close(PL_last_in_gv, FALSE))
- warn("internal error: glob failed");
+ if (!do_close(PL_last_in_gv, FALSE) && ckWARN(WARN_CLOSED)) {
+ warner(WARN_CLOSED,
+ "glob failed (child exited with status %d%s)",
+ STATUS_CURRENT >> 8,
+ (STATUS_CURRENT & 0x80) ? ", core dumped" : "");
+ }
}
if (gimme == G_SCALAR) {
(void)SvOK_off(TARG);
EXTEND(SP, 1);
cx = &cxstack[cxstack_ix];
- if (cx->cx_type != CXt_LOOP)
+ if (CxTYPE(cx) != CXt_LOOP)
DIE("panic: pp_iter");
av = cx->blk_loop.iterary;
&& SvTYPE(rx->check_substr) == SVt_PVBM
&& SvVALID(rx->check_substr))
? TARG : Nullsv);
- safebase = (!rx->nparens && !PL_sawampersand) ? 0 : REXEC_COPY_STR;
+ safebase = (rx->nparens || SvTEMP(TARG) || PL_sawampersand)
+ ? REXEC_COPY_STR : 0;
if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
SAVEINT(PL_multiline);
PL_multiline = pm->op_pmflags & PMf_MULTILINE;
if (PL_screamfirst[BmRARE(rx->check_substr)] < 0)
goto nope;
- b = HOP((U8*)s, rx->check_offset_min);
+ b = (char*)HOP((U8*)s, rx->check_offset_min);
if (!(s = screaminstr(TARG, rx->check_substr, b - s, 0, &p, 0)))
goto nope;
}
goto nope;
if (s && rx->check_offset_max < s - m) {
++BmUSEFUL(rx->check_substr);
- s = HOP((U8*)s, -rx->check_offset_max);
+ s = (char*)HOP((U8*)s, -rx->check_offset_max);
}
else
s = m;
beginning of match, and the match is anchored at s. */
else if (!PL_multiline) { /* Anchored at beginning of string. */
I32 slen;
- char *b = HOP((U8*)s, rx->check_offset_min);
+ char *b = (char*)HOP((U8*)s, rx->check_offset_min);
if (*SvPVX(rx->check_substr) != *b
|| ((slen = SvCUR(rx->check_substr)) > 1
&& memNE(SvPVX(rx->check_substr), b, slen)))
DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: pp_entersub lock %p\n",
thr, sv);)
MUTEX_UNLOCK(MgMUTEXP(mg));
- SvREFCNT_inc(sv); /* Keep alive until magic_mutexfree */
save_destructor(unlock_condpair, sv);
}
MUTEX_LOCK(CvMUTEXP(cv));
PUSHBLOCK(cx, CXt_SUB, MARK);
PUSHSUB(cx);
CvDEPTH(cv)++;
+ /* XXX This would be a natural place to set C<PL_compcv = cv> so
+ * that eval'' ops within this sub know the correct lexical space.
+ * Owing the speed considerations, we choose to search for the cv
+ * in doeval() instead.
+ */
if (CvDEPTH(cv) < 2)
(void)SvREFCNT_inc(cv);
else { /* save temporaries on recursion? */
- if (CvDEPTH(cv) == 100 && ckWARN(WARN_RECURSION)
- && !(PERLDB_SUB && cv == GvCV(PL_DBsub)))
- sub_crush_depth(cv);
if (CvDEPTH(cv) > AvFILLp(padlist)) {
AV *av;
AV *newpad = newAV();
MARK++;
}
}
+ /* warning must come *after* we fully set up the context
+ * stuff so that __WARN__ handlers can safely dounwind()
+ * if they want to
+ */
+ if (CvDEPTH(cv) == 100 && ckWARN(WARN_RECURSION)
+ && !(PERLDB_SUB && cv == GvCV(PL_DBsub)))
+ sub_crush_depth(cv);
#if 0
DEBUG_S(PerlIO_printf(PerlIO_stderr(),
"%p entersub returning %p\n", thr, CvSTART(cv)));
!(iogv = gv_fetchpv(packname, FALSE, SVt_PVIO)) ||
!(ob=(SV*)GvIO(iogv)))
{
- if (!packname || !isIDFIRST(*packname))
+ if (!packname ||
+ ((*(U8*)packname >= 0xc0 && IN_UTF8)
+ ? !isIDFIRST_utf8(packname)
+ : !isIDFIRST(*packname)
+ ))
+ {
DIE("Can't call method \"%s\" %s", name,
SvOK(sv)? "without a package or object reference"
: "on an undefined value");
+ }
stash = gv_stashpvn(packname, packlen, TRUE);
goto fetch;
}