}
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)
#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:
*/