}
else {
exsv = TOPs;
+ if (SvGMAGICAL(exsv)) exsv = sv_mortalcopy(exsv);
}
if (SvROK(exsv) || (SvPV_const(exsv, len), len)) {
/* well-formed exception supplied */
}
- else if (SvROK(ERRSV)) {
- exsv = ERRSV;
- }
- else if (SvPOK(ERRSV) && SvCUR(ERRSV)) {
- exsv = sv_mortalcopy(ERRSV);
- sv_catpvs(exsv, "\t...caught");
- }
else {
+ SvGETMAGIC(ERRSV);
+ if (SvROK(ERRSV)) {
+ if (SvGMAGICAL(ERRSV)) {
+ exsv = sv_newmortal();
+ sv_setsv_nomg(exsv, ERRSV);
+ }
+ else exsv = ERRSV;
+ }
+ else if (SvPOKp(ERRSV) ? SvCUR(ERRSV) : SvNIOKp(ERRSV)) {
+ exsv = sv_newmortal();
+ sv_setsv_nomg(exsv, ERRSV);
+ sv_catpvs(exsv, "\t...caught");
+ }
+ else {
exsv = newSVpvs_flags("Warning: something's wrong", SVs_TEMP);
+ }
}
if (SvROK(exsv) && !PL_warnhook)
Perl_warn(aTHX_ "%"SVf, SVfARG(exsv));
Perl_setdefout(pTHX_ GV *gv)
{
dVAR;
- SvREFCNT_inc_simple_void(gv);
+ PERL_ARGS_ASSERT_SETDEFOUT;
+ SvREFCNT_inc_simple_void_NN(gv);
SvREFCNT_dec(PL_defoutgv);
PL_defoutgv = gv;
}
else
fgv = gv;
- if (!fgv)
- goto not_a_format_reference;
+ assert(fgv);
cv = GvFORM(fgv);
if (!cv) {
tmpsv = sv_newmortal();
gv_efullname4(tmpsv, fgv, NULL, FALSE);
- if (SvPOK(tmpsv) && *SvPV_nolen_const(tmpsv))
- DIE(aTHX_ "Undefined format \"%"SVf"\" called", SVfARG(tmpsv));
-
- not_a_format_reference:
- DIE(aTHX_ "Not a format reference");
+ DIE(aTHX_ "Undefined format \"%"SVf"\" called", SVfARG(tmpsv));
}
IoFLAGS(io) &= ~IOf_DIDTOP;
- return doform(cv,gv,PL_op->op_next);
+ RETURNOP(doform(cv,gv,PL_op->op_next));
}
PP(pp_leavewrite)
register PERL_CONTEXT *cx;
OP *retop;
+ /* I'm not sure why, but executing the format leaves an extra value on the
+ * stack. There's probably a better place to be handling this (probably
+ * by avoiding pushing it in the first place!) but I don't quite know
+ * where to look. -doy */
+ (void)POPs;
+
if (!io || !(ofp = IoOFP(io)))
goto forget_top;
if (!cv) {
SV * const sv = sv_newmortal();
gv_efullname4(sv, fgv, NULL, FALSE);
- if (SvPOK(sv) && *SvPV_nolen_const(sv))
- DIE(aTHX_ "Undefined top format \"%"SVf"\" called", SVfARG(sv));
- else
- DIE(aTHX_ "Undefined top format called");
+ DIE(aTHX_ "Undefined top format \"%"SVf"\" called", SVfARG(sv));
}
- return doform(cv, gv, PL_op);
+ RETURNOP(doform(cv, gv, PL_op));
}
forget_top:
}
/* bad_ofp: */
PL_formtarget = PL_bodytarget;
- PUTBACK;
PERL_UNUSED_VAR(newsp);
PERL_UNUSED_VAR(gimme);
- return retop;
+ RETURNOP(retop);
}
PP(pp_prtf)
while (OP_IS_FILETEST(next->op_type)
&& next->op_private & OPpFT_STACKED)
next = next->op_next;
- if (PL_op->op_flags & OPf_REF) PUSHs(ret);
+ if (PL_op->op_flags & OPf_REF) XPUSHs(ret);
else SETs(ret);
PUTBACK;
return next;
STMT_START { \
if (PL_op->op_private & OPpFT_STACKING) \
return S_ft_stacking_return_false(aTHX_ X); \
- RETURNX(PL_op->op_flags & OPf_REF ? PUSHs(X) : SETs(X)); \
+ RETURNX(PL_op->op_flags & OPf_REF ? XPUSHs(X) : SETs(X)); \
} STMT_END
#define FT_RETURN_TRUE(X) \
RETURNX((void)( \
PL_op->op_flags & OPf_REF \
- ? PUSHs( \
+ ? (bool)XPUSHs( \
PL_op->op_private & OPpFT_STACKING ? (SV *)cGVOP_gv : (X) \
) \
- : (void)(PL_op->op_private & OPpFT_STACKING || SETs(X)) \
+ : (PL_op->op_private & OPpFT_STACKING || SETs(X)) \
))
#define FT_RETURNNO FT_RETURN_FALSE(&PL_sv_no)
if (!tmpsv)
return NULL;
- SPAGAIN;
-
if (SvTRUE(tmpsv)) FT_RETURN_TRUE(tmpsv);
FT_RETURN_FALSE(tmpsv);
}
}
result = my_stat_flags(0);
- SPAGAIN;
if (result < 0)
FT_RETURNUNDEF;
if (cando(stat_mode, effective, &PL_statcache))
tryAMAGICftest_MG(opchar);
result = my_stat_flags(0);
- SPAGAIN;
if (result < 0)
FT_RETURNUNDEF;
if (op_type == OP_FTIS)
#endif
result = my_stat_flags(0);
- SPAGAIN;
if (result < 0)
FT_RETURNUNDEF;
switch (PL_op->op_type) {
tryAMAGICftest_MG('l');
result = my_lstat_flags(0);
- SPAGAIN;
if (result < 0)
FT_RETURNUNDEF;
tryAMAGICftest_MG(PL_op->op_type == OP_FTTEXT ? 'T' : 'B');
if (PL_op->op_flags & OPf_REF)
- {
gv = cGVOP_gv;
- EXTEND(SP, 1);
- }
else if ((PL_op->op_private & (OPpFT_STACKED|OPpFT_AFTER_t))
== OPpFT_STACKED)
gv = PL_defgv;
#ifdef HAS_FORK
dVAR; dSP; dTARGET;
Pid_t childpid;
+#if defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO)
+ sigset_t oldmask, newmask;
+#endif
EXTEND(SP, 1);
PERL_FLUSHALL_FOR_CHILD;
+#if defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO)
+ sigfillset(&newmask);
+ sigprocmask(SIG_SETMASK, &newmask, &oldmask);
+#endif
childpid = PerlProc_fork();
+ if (childpid == 0) {
+ int sig;
+ PL_sig_pending = 0;
+ if (PL_psig_pend)
+ for (sig = 1; sig < SIG_SIZE; sig++)
+ PL_psig_pend[sig] = 0;
+ }
+#if defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO)
+ {
+ dSAVE_ERRNO;
+ sigprocmask(SIG_SETMASK, &oldmask, NULL);
+ RESTORE_ERRNO;
+ }
+#endif
if (childpid < 0)
RETSETUNDEF;
if (!childpid) {
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
* End:
*
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
*/