From: Nicholas Clark <nick@ccl4.org>
Date: Sat, 16 Oct 2004 18:16:12 +0000 (+0000)
Subject: Merge code from vdie and vcroak into S_vdie_croak_common
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3ab1ac99cac69a50df98e9a6b2a9d1217de1d092;p=p5sagit%2Fp5-mst-13.2.git

Merge code from vdie and vcroak into S_vdie_croak_common

p4raw-id: //depot/perl@23376
---

diff --git a/util.c b/util.c
index 81d1ef7..52319d3 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;