diff options
author | Nicholas Clark <nick@ccl4.org> | 2004-10-16 18:16:12 +0000 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2004-10-16 18:16:12 +0000 |
commit | 3ab1ac99cac69a50df98e9a6b2a9d1217de1d092 (patch) | |
tree | c803880efb61860a6695c89034e54d4e35f65342 /util.c | |
parent | 63315e187a785a8535d1f84110e060293f0f744c (diff) | |
download | perl-3ab1ac99cac69a50df98e9a6b2a9d1217de1d092.tar.gz |
Merge code from vdie and vcroak into S_vdie_croak_common
p4raw-id: //depot/perl@23376
Diffstat (limited to 'util.c')
-rw-r--r-- | util.c | 114 |
1 files changed, 36 insertions, 78 deletions
@@ -1037,6 +1037,40 @@ Perl_write_to_stderr(pTHX_ const char* message, int msglen) } } +/* Common code used by vcroak, vdie and vwarner */ + +void S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32 utf8); + +char * +S_vdie_croak_common(pTHX_ const char* pat, va_list* args, STRLEN* msglen, + I32* utf8) +{ + char *message; + + if (pat) { + SV *msv = vmess(pat, args); + if (PL_errors && SvCUR(PL_errors)) { + sv_catsv(PL_errors, msv); + message = SvPV(PL_errors, *msglen); + SvCUR_set(PL_errors, 0); + } + else + message = SvPV(msv,*msglen); + *utf8 = SvUTF8(msv); + } + else { + message = Nullch; + } + + DEBUG_S(PerlIO_printf(Perl_debug_log, + "%p: die/croak: message = %s\ndiehook = %p\n", + thr, message, PL_diehook)); + if (PL_diehook) { + S_vdie_common(aTHX_ message, *msglen, *utf8); + } + return message; +} + void S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32 utf8) { @@ -1083,7 +1117,6 @@ Perl_vdie(pTHX_ const char* pat, va_list *args) { char *message; int was_in_eval = PL_in_eval; - SV *msv; STRLEN msglen; I32 utf8 = 0; @@ -1091,28 +1124,7 @@ Perl_vdie(pTHX_ const char* pat, va_list *args) "%p: die: curstack = %p, mainstack = %p\n", thr, PL_curstack, PL_mainstack)); - if (pat) { - msv = vmess(pat, args); - if (PL_errors && SvCUR(PL_errors)) { - sv_catsv(PL_errors, msv); - message = SvPV(PL_errors, msglen); - SvCUR_set(PL_errors, 0); - } - else - message = SvPV(msv,msglen); - utf8 = SvUTF8(msv); - } - else { - message = Nullch; - msglen = 0; - } - - DEBUG_S(PerlIO_printf(Perl_debug_log, - "%p: die: message = %s\ndiehook = %p\n", - thr, message, PL_diehook)); - if (PL_diehook) { - S_vdie_common(aTHX_ message, msglen, utf8); - } + message = S_vdie_croak_common(aTHX_ pat, args, &msglen, &utf8); PL_restartop = die_where(message, msglen); SvFLAGS(ERRSV) |= utf8; @@ -1153,65 +1165,11 @@ void Perl_vcroak(pTHX_ const char* pat, va_list *args) { char *message; - HV *stash; - GV *gv; - CV *cv; - SV *msv; STRLEN msglen; I32 utf8 = 0; - if (pat) { - msv = vmess(pat, args); - if (PL_errors && SvCUR(PL_errors)) { - sv_catsv(PL_errors, msv); - message = SvPV(PL_errors, msglen); - SvCUR_set(PL_errors, 0); - } - else - message = SvPV(msv,msglen); - utf8 = SvUTF8(msv); - } - else { - message = Nullch; - msglen = 0; - } - - DEBUG_S(PerlIO_printf(Perl_debug_log, "croak: 0x%"UVxf" %s", - PTR2UV(thr), message)); - - if (PL_diehook) { - /* sv_2cv might call Perl_croak() */ - SV *olddiehook = PL_diehook; - ENTER; - SAVESPTR(PL_diehook); - PL_diehook = Nullsv; - cv = sv_2cv(olddiehook, &stash, &gv, 0); - LEAVE; - if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) { - dSP; - SV *msg; - - ENTER; - save_re_context(); - if (message) { - msg = newSVpvn(message, msglen); - SvFLAGS(msg) |= utf8; - SvREADONLY_on(msg); - SAVEFREESV(msg); - } - else { - msg = ERRSV; - } + message = S_vdie_croak_common(aTHX_ pat, args, &msglen, &utf8); - PUSHSTACKi(PERLSI_DIEHOOK); - PUSHMARK(SP); - XPUSHs(msg); - PUTBACK; - call_sv((SV*)cv, G_DISCARD); - POPSTACK; - LEAVE; - } - } if (PL_in_eval) { PL_restartop = die_where(message, msglen); SvFLAGS(ERRSV) |= utf8; |