diff options
| -rw-r--r-- | mg.c | 37 | ||||
| -rw-r--r-- | op.c | 9 | ||||
| -rw-r--r-- | perl.c | 8 | ||||
| -rw-r--r-- | pp_ctl.c | 16 | ||||
| -rw-r--r-- | pp_sys.c | 66 | ||||
| -rw-r--r-- | regcomp.c | 10 | ||||
| -rw-r--r-- | toke.c | 12 | ||||
| -rw-r--r-- | utf8.c | 14 |
8 files changed, 99 insertions, 73 deletions
@@ -3139,8 +3139,10 @@ Perl_sighandler(int sig) call_sv(MUTABLE_SV(cv), G_DISCARD|G_EVAL); POPSTACK; - if (SvTRUE(ERRSV)) { - SvREFCNT_dec(errsv_save); + { + SV * const errsv = ERRSV; + if (SvTRUE_NN(errsv)) { + SvREFCNT_dec(errsv_save); #ifndef PERL_MICRO /* Handler "died", for example to get out of a restart-able read(). * Before we re-do that on its behalf re-enable the signal which was @@ -3148,25 +3150,26 @@ Perl_sighandler(int sig) */ #ifdef HAS_SIGPROCMASK #if defined(HAS_SIGACTION) && defined(SA_SIGINFO) - if (sip || uap) + if (sip || uap) #endif - { - sigset_t set; - sigemptyset(&set); - sigaddset(&set,sig); - sigprocmask(SIG_UNBLOCK, &set, NULL); - } + { + sigset_t set; + sigemptyset(&set); + sigaddset(&set,sig); + sigprocmask(SIG_UNBLOCK, &set, NULL); + } #else - /* Not clear if this will work */ - (void)rsignal(sig, SIG_IGN); - (void)rsignal(sig, PL_csighandlerp); + /* Not clear if this will work */ + (void)rsignal(sig, SIG_IGN); + (void)rsignal(sig, PL_csighandlerp); #endif #endif /* !PERL_MICRO */ - die_sv(ERRSV); - } - else { - sv_setsv(ERRSV, errsv_save); - SvREFCNT_dec(errsv_save); + die_sv(errsv); + } + else { + sv_setsv(errsv, errsv_save); + SvREFCNT_dec(errsv_save); + } } cleanup: @@ -7379,14 +7379,13 @@ Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, const char *s = strrchr(name, ':'); s = s ? s+1 : name; if (strEQ(s, "BEGIN")) { - const char not_safe[] = - "BEGIN not safe after errors--compilation aborted"; if (PL_in_eval & EVAL_KEEPERR) - Perl_croak(aTHX_ not_safe); + Perl_croak_nocontext("BEGIN not safe after errors--compilation aborted"); else { + SV * const errsv = ERRSV; /* force display of errors found but not reported */ - sv_catpv(ERRSV, not_safe); - Perl_croak(aTHX_ "%"SVf, SVfARG(ERRSV)); + sv_catpvs(errsv, "BEGIN not safe after errors--compilation aborted"); + Perl_croak_nocontext("%"SVf, SVfARG(errsv)); } } } @@ -2905,8 +2905,12 @@ Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error) PUTBACK; } - if (croak_on_error && SvTRUE(ERRSV)) { - Perl_croak(aTHX_ "%s", SvPVx_nolen_const(ERRSV)); + /* just check empty string or undef? */ + if (croak_on_error) { + SV * const errsv = ERRSV; + if(SvTRUE_NN(errsv)) + /* replace with croak_sv? */ + Perl_croak_nocontext("%s", SvPV_nolen_const(errsv)); } return sv; @@ -3445,6 +3445,7 @@ S_doeval(pTHX_ int gimme, CV* outside, U32 seq, HV *hh) PERL_CONTEXT *cx; I32 optype; /* Used by POPEVAL. */ SV *namesv; + SV *errsv = NULL; cx = NULL; namesv = NULL; @@ -3467,6 +3468,7 @@ S_doeval(pTHX_ int gimme, CV* outside, U32 seq, HV *hh) LEAVE_with_name("eval"); /* pp_entereval knows about this LEAVE. */ } + errsv = ERRSV; if (in_require) { if (!cx) { /* If cx is still NULL, it means that we didn't go in the @@ -3480,13 +3482,13 @@ S_doeval(pTHX_ int gimme, CV* outside, U32 seq, HV *hh) SvUTF8(namesv) ? -(I32)SvCUR(namesv) : (I32)SvCUR(namesv), &PL_sv_undef, 0); Perl_croak(aTHX_ "%"SVf"Compilation failed in require", - SVfARG(ERRSV - ? ERRSV + SVfARG(errsv + ? errsv : newSVpvs_flags("Unknown error\n", SVs_TEMP))); } else { - if (!*(SvPVx_nolen_const(ERRSV))) { - sv_setpvs(ERRSV, "Compilation error"); + if (!*(SvPV_nolen_const(errsv))) { + sv_setpvs(errsv, "Compilation error"); } } if (gimme != G_ARRAY) PUSHs(&PL_sv_undef); @@ -5367,8 +5369,10 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen) if (SvOK(out)) { status = SvIV(out); } - else if (SvTRUE(ERRSV)) { - err = newSVsv(ERRSV); + else { + SV * const errsv = ERRSV; + if (SvTRUE_NN(errsv)) + err = newSVsv(errsv); } } @@ -445,17 +445,18 @@ PP(pp_warn) /* well-formed exception supplied */ } else { - SvGETMAGIC(ERRSV); - if (SvROK(ERRSV)) { - if (SvGMAGICAL(ERRSV)) { + SV * const errsv = ERRSV; + SvGETMAGIC(errsv); + if (SvROK(errsv)) { + if (SvGMAGICAL(errsv)) { exsv = sv_newmortal(); - sv_setsv_nomg(exsv, ERRSV); + sv_setsv_nomg(exsv, errsv); } - else exsv = ERRSV; + else exsv = errsv; } - else if (SvPOKp(ERRSV) ? SvCUR(ERRSV) : SvNIOKp(ERRSV)) { + else if (SvPOKp(errsv) ? SvCUR(errsv) : SvNIOKp(errsv)) { exsv = sv_newmortal(); - sv_setsv_nomg(exsv, ERRSV); + sv_setsv_nomg(exsv, errsv); sv_catpvs(exsv, "\t...caught"); } else { @@ -489,32 +490,35 @@ PP(pp_die) if (SvROK(exsv) || (SvPV_const(exsv, len), len)) { /* well-formed exception supplied */ } - else if (SvROK(ERRSV)) { - exsv = ERRSV; - if (sv_isobject(exsv)) { - HV * const stash = SvSTASH(SvRV(exsv)); - GV * const gv = gv_fetchmethod(stash, "PROPAGATE"); - if (gv) { - SV * const file = sv_2mortal(newSVpv(CopFILE(PL_curcop),0)); - SV * const line = sv_2mortal(newSVuv(CopLINE(PL_curcop))); - EXTEND(SP, 3); - PUSHMARK(SP); - PUSHs(exsv); - PUSHs(file); - PUSHs(line); - PUTBACK; - call_sv(MUTABLE_SV(GvCV(gv)), - G_SCALAR|G_EVAL|G_KEEPERR); - exsv = sv_mortalcopy(*PL_stack_sp--); + else { + SV * const errsv = ERRSV; + if (SvROK(errsv)) { + exsv = errsv; + if (sv_isobject(exsv)) { + HV * const stash = SvSTASH(SvRV(exsv)); + GV * const gv = gv_fetchmethod(stash, "PROPAGATE"); + if (gv) { + SV * const file = sv_2mortal(newSVpv(CopFILE(PL_curcop),0)); + SV * const line = sv_2mortal(newSVuv(CopLINE(PL_curcop))); + EXTEND(SP, 3); + PUSHMARK(SP); + PUSHs(exsv); + PUSHs(file); + PUSHs(line); + PUTBACK; + call_sv(MUTABLE_SV(GvCV(gv)), + G_SCALAR|G_EVAL|G_KEEPERR); + exsv = sv_mortalcopy(*PL_stack_sp--); + } } } - } - else if (SvPV_const(ERRSV, len), len) { - exsv = sv_mortalcopy(ERRSV); - sv_catpvs(exsv, "\t...propagated"); - } - else { - exsv = newSVpvs_flags("Died", SVs_TEMP); + else if (SvPV_const(errsv, len), len) { + exsv = sv_mortalcopy(errsv); + sv_catpvs(exsv, "\t...propagated"); + } + else { + exsv = newSVpvs_flags("Died", SVs_TEMP); + } } return die_sv(exsv); } @@ -5095,10 +5095,14 @@ S_compile_runtime_code(pTHX_ RExC_state_t * const pRExC_state, SPAGAIN; qr_ref = POPs; PUTBACK; - if (SvTRUE(ERRSV)) { - Safefree(pRExC_state->code_blocks); - Perl_croak(aTHX_ "%s", SvPVx_nolen_const(ERRSV)); + SV * const errsv = ERRSV; + if (SvTRUE_NN(errsv)) + { + Safefree(pRExC_state->code_blocks); + /* use croak_sv ? */ + Perl_croak_nocontext("%s", SvPV_nolen_const(errsv)); + } } assert(SvROK(qr_ref)); qr = SvRV(qr_ref); @@ -9019,6 +9019,7 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, STRLEN keylen, dVAR; dSP; HV * table = GvHV(PL_hintgv); /* ^H */ SV *res; + SV *errsv = NULL; SV **cvp; SV *cv, *typesv; const char *why1 = "", *why2 = "", *why3 = ""; @@ -9112,11 +9113,11 @@ now_ok: SPAGAIN ; /* Check the eval first */ - if (!PL_in_eval && SvTRUE(ERRSV)) { + if (!PL_in_eval && ((errsv = ERRSV), SvTRUE_NN(errsv))) { STRLEN errlen; const char * errstr; - sv_catpvs(ERRSV, "Propagated"); - errstr = SvPV_const(ERRSV, errlen); + sv_catpvs(errsv, "Propagated"); + errstr = SvPV_const(errsv, errlen); yyerror_pvn(errstr, errlen, 0); /* Duplicates the message inside eval */ (void)POPs; res = SvREFCNT_inc_simple(sv); @@ -11264,9 +11265,10 @@ Perl_yyerror_pvn(pTHX_ const char *const s, STRLEN len, U32 flags) else qerror(msg); if (PL_error_count >= 10) { - if (PL_in_eval && SvCUR(ERRSV)) + SV * errsv; + if (PL_in_eval && ((errsv = ERRSV), SvCUR(errsv))) Perl_croak(aTHX_ "%"SVf"%s has too many errors.\n", - SVfARG(ERRSV), OutCopFILE(PL_curcop)); + SVfARG(errsv), OutCopFILE(PL_curcop)); else Perl_croak(aTHX_ "%s has too many errors.\n", OutCopFILE(PL_curcop)); @@ -2863,8 +2863,11 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m #endif Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, newSVpvn(pkg,pkg_len), NULL); - if (!SvTRUE(ERRSV)) - sv_setsv(ERRSV, errsv_save); + { + SV * const errsv = ERRSV; + if (!SvTRUE_NN(errsv)) + sv_setsv(errsv, errsv_save); + } LEAVE; } SPAGAIN; @@ -2887,8 +2890,11 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m retval = *PL_stack_sp--; SvREFCNT_inc(retval); } - if (!SvTRUE(ERRSV)) - sv_setsv(ERRSV, errsv_save); + { + SV * const errsv = ERRSV; + if (!SvTRUE_NN(errsv)) + sv_setsv(errsv, errsv_save); + } LEAVE; POPSTACK; if (IN_PERL_COMPILETIME) { |