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 (file)
--- 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;