summaryrefslogtreecommitdiff
path: root/util.c
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2004-10-16 18:16:12 +0000
committerNicholas Clark <nick@ccl4.org>2004-10-16 18:16:12 +0000
commit3ab1ac99cac69a50df98e9a6b2a9d1217de1d092 (patch)
treec803880efb61860a6695c89034e54d4e35f65342 /util.c
parent63315e187a785a8535d1f84110e060293f0f744c (diff)
downloadperl-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.c114
1 files changed, 36 insertions, 78 deletions
diff --git a/util.c b/util.c
index 81d1ef74b0..52319d32fb 100644
--- a/util.c
+++ b/util.c
@@ -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;