*/
/*
- * Now far ahead the Road has gone,
- * And I must follow, if I can,
- * Pursuing it with eager feet,
- * Until it joins some larger way
- * Where many paths and errands meet.
- * And whither then? I cannot say.
+ * Now far ahead the Road has gone,
+ * And I must follow, if I can,
+ * Pursuing it with eager feet,
+ * Until it joins some larger way
+ * Where many paths and errands meet.
+ * And whither then? I cannot say.
+ *
+ * [Bilbo on p.35 of _The Lord of the Rings_, I/i: "A Long-Expected Party"]
*/
/* This file contains control-oriented pp ("push/pop") functions that
}
}
-void
-Perl_rxres_restore(pTHX_ void **rsp, REGEXP *rx)
+static void
+S_rxres_restore(pTHX_ void **rsp, REGEXP *rx)
{
UV *p = (UV*)*rsp;
U32 i;
}
}
-void
-Perl_rxres_free(pTHX_ void **rsp)
+static void
+S_rxres_free(pTHX_ void **rsp)
{
UV * const p = (UV*)*rsp;
if (!targ_is_utf8 && DO_UTF8(tmpForm)) {
SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget));
*t = '\0';
- sv_utf8_upgrade(PL_formtarget);
- SvGROW(PL_formtarget, SvCUR(PL_formtarget) + fudge + 1);
+ sv_utf8_upgrade_flags_grow(PL_formtarget, SV_GMAGIC, fudge + 1);
t = SvEND(PL_formtarget);
targ_is_utf8 = TRUE;
}
if (!targ_is_utf8) {
SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget));
*t = '\0';
- sv_utf8_upgrade(PL_formtarget);
- SvGROW(PL_formtarget, SvCUR(PL_formtarget) + fudge + 1);
+ sv_utf8_upgrade_flags_grow(PL_formtarget, SV_GMAGIC,
+ fudge + 1);
t = SvEND(PL_formtarget);
targ_is_utf8 = TRUE;
}
t - SvPVX_const(PL_formtarget));
targ_is_utf8 = TRUE;
/* Don't need get magic. */
- sv_utf8_upgrade_flags(PL_formtarget, 0);
+ sv_utf8_upgrade_nomg(PL_formtarget);
} else {
SvCUR_set(PL_formtarget,
t - SvPVX_const(PL_formtarget));
if (PL_op->op_private & OPpGREP_LEX)
PAD_SVl(PL_op->op_targ) = src;
else
- DEFSV = src;
+ DEFSV_set(src);
PUTBACK;
if (PL_op->op_type == OP_MAPSTART)
if (PL_op->op_private & OPpGREP_LEX)
PAD_SVl(PL_op->op_targ) = src;
else
- DEFSV = src;
+ DEFSV_set(src);
RETURNOP(cLOGOP->op_other);
}
sv_catpvn(err, message, msglen);
if (ckWARN(WARN_MISC)) {
const STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1;
- Perl_warner(aTHX_ packWARN(WARN_MISC), SvPVX_const(err)+start);
+ Perl_warner(aTHX_ packWARN(WARN_MISC), "%s",
+ SvPVX_const(err)+start);
}
}
}
/* Get the bit mask for $warnings::Bits{all}, because
* it could have been extended by warnings::register */
SV **bits_all;
- HV * const bits = get_hv("warnings::Bits", FALSE);
+ HV * const bits = get_hv("warnings::Bits", 0);
if (bits && (bits_all=hv_fetchs(bits, "all", FALSE))) {
mask = newSVsv(*bits_all);
}
#endif
}
else {
- GV * const gv = (GV*)POPs;
+ GV * const gv = MUTABLE_GV(POPs);
svp = &GvSV(gv); /* symbol table variable */
SAVEGENERICSV(*svp);
*svp = newSV(0);
if (PERLDB_SUB) { /* Checking curstash breaks DProf. */
Perl_get_db_sub(aTHX_ NULL, cv);
if (PERLDB_GOTO) {
- CV * const gotocv = get_cv("DB::goto", FALSE);
+ CV * const gotocv = get_cvs("DB::goto", 0);
if (gotocv) {
PUSHMARK( PL_stack_sp );
call_sv(MUTABLE_SV(gotocv), G_SCALAR | G_NODEBUG);
const char *t;
SV * const tmpstr = newSV_type(SVt_PVMG);
- t = strchr(s, '\n');
+ t = (const char *)memchr(s, '\n', send - s);
if (t)
t++;
else
POPEVAL(cx);
}
lex_end();
- LEAVE;
+ LEAVE; /* pp_entereval knows about this LEAVE. */
msg = SvPVx_nolen_const(ERRSV);
if (optype == OP_REQUIRE) {
/* Register with debugger: */
if (PERLDB_INTER && saveop && saveop->op_type == OP_REQUIRE) {
- CV * const cv = get_cv("DB::postponed", FALSE);
+ CV * const cv = get_cvs("DB::postponed", 0);
if (cv) {
dSP;
PUSHMARK(SP);
}
if (isGV_with_GP(arg)) {
- IO * const io = GvIO((GV *)arg);
+ IO * const io = GvIO((const GV *)arg);
++filter_has_file;
if (filter_sub || filter_cache) {
SV * const datasv = filter_add(S_run_user_filter, NULL);
IoLINES(datasv) = filter_has_file;
- IoTOP_GV(datasv) = (GV *)filter_state;
- IoBOTTOM_GV(datasv) = (GV *)filter_sub;
- IoFMT_GV(datasv) = (GV *)filter_cache;
+ IoTOP_GV(datasv) = MUTABLE_GV(filter_state);
+ IoBOTTOM_GV(datasv) = MUTABLE_GV(filter_sub);
+ IoFMT_GV(datasv) = MUTABLE_GV(filter_cache);
}
/* switch to eval mode */
register PERL_CONTEXT *cx;
SV *sv;
const I32 gimme = GIMME_V;
- const I32 was = PL_sub_generation;
+ const U32 was = PL_breakable_sub_gen;
char tbuf[TYPE_DIGITS(long) + 12];
char *tmpbuf = tbuf;
- char *safestr;
STRLEN len;
- bool ok;
CV* runcv;
U32 seq;
HV *saved_hh = NULL;
- const char * const fakestr = "_<(eval )";
- const int fakelen = 9 + 1;
-
+
if (PL_op->op_private & OPpEVAL_HAS_HH) {
saved_hh = MUTABLE_HV(SvREFCNT_inc(POPs));
}
(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 */
- safestr = savepvn(tmpbuf, len);
- SAVEDELETE(PL_defstash, safestr, len);
SAVEHINTS();
PL_hints = PL_op->op_targ;
if (saved_hh)
/* prepare to compile string */
- if (PERLDB_LINE && PL_curstash != PL_debstash)
+ if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
save_lines(CopFILEAV(&PL_compiling), PL_parser->linestr);
PUTBACK;
- ok = doeval(gimme, NULL, runcv, seq);
- if (PERLDB_INTER && was != (I32)PL_sub_generation /* Some subs defined here. */
- && ok) {
- /* Copy in anything fake and short. */
- my_strlcpy(safestr, fakestr, fakelen);
+
+ if (doeval(gimme, NULL, runcv, seq)) {
+ if (was != PL_breakable_sub_gen /* Some subs defined here. */
+ ? (PERLDB_LINE || PERLDB_SAVESRC)
+ : PERLDB_SAVESRC_NOSUBS) {
+ /* Retain the filegv we created. */
+ } else {
+ char *const safestr = savepvn(tmpbuf, len);
+ SAVEDELETE(PL_defstash, safestr, len);
+ }
+ return DOCATCH(PL_eval_start);
+ } else {
+ /* We have already left the scope set up earler thanks to the LEAVE
+ in doeval(). */
+ if (was != PL_breakable_sub_gen /* Some subs defined here. */
+ ? (PERLDB_LINE || PERLDB_SAVESRC)
+ : PERLDB_SAVESRC_INVALID) {
+ /* Retain the filegv we created. */
+ } else {
+ (void)hv_delete(PL_defstash, tmpbuf, len, G_DISCARD);
+ }
+ return PL_op->op_next;
}
- return ok ? DOCATCH(PL_eval_start) : PL_op->op_next;
}
PP(pp_leaveeval)
if (SvGMAGICAL(e))
e = sv_mortalcopy(e);
- if (SM_OBJECT)
- Perl_croak(aTHX_ "Smart matching a non-overloaded object breaks encapsulation");
+ if (SM_OBJECT) {
+ if (!SvOK(d) || !SvOK(e))
+ RETPUSHNO;
+ else
+ Perl_croak(aTHX_ "Smart matching a non-overloaded object breaks encapsulation");
+ }
if (SM_CV_NEP) {
I32 c;
SAVETMPS;
EXTEND(SP, 2);
- DEFSV = upstream;
+ DEFSV_set(upstream);
PUSHMARK(SP);
mPUSHi(0);
if (filter_state) {
SV *cache = MUTABLE_SV(IoFMT_GV(datasv));
if (!cache) {
- IoFMT_GV(datasv) = (GV*) (cache = newSV(got_len - umaxlen));
+ IoFMT_GV(datasv) = MUTABLE_GV((cache = newSV(got_len - umaxlen)));
} else if (SvOK(cache)) {
/* Cache should be empty. */
assert(!SvCUR(cache));