Use of SV* instead of message, msglen, utf8 to contain error message

diff --git a/embed.fnc b/embed.fnc
index 090b243..d107614 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -218,7 +218,7 @@ Afp |OP*    |die            |NULLOK const char* pat|...
 s      |OP*    |vdie           |NULLOK const char* pat|NULLOK va_list* args
 #endif
 : Used in util.c
-p      |OP*    |die_where      |NULLOK const char* message|STRLEN msglen
+p      |OP*    |die_where      |NULLOK SV* msv
 Ap     |void   |dounwind       |I32 cxix
 : FIXME
 pmb    |bool   |do_aexec       |NULLOK SV* really|NN SV** mark|NN SV** sp
@@ -1189,7 +1189,7 @@ Ap        |void   |vwarner        |U32 err|NN const char* pat|NULLOK va_list* args
 p      |void   |watch          |NN char** addr
 Ap     |I32    |whichsig       |NN const char* sig
 : Used in pp_ctl.c
-p      |void   |write_to_stderr|NN const char* message|int msglen
+p      |void   |write_to_stderr|NN SV* msv
 : Used in op.c
 p      |int    |yyerror        |NN const char *const s
 : Used in perly.y, and by Data::Alias
@@ -1846,10 +1846,8 @@ s        |char*  |stdize_locale  |NN char* locs
 #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
 s      |const COP*|closest_cop |NN const COP *cop|NULLOK const OP *o
 s      |SV*    |mess_alloc
-s      |const char *|vdie_croak_common|NULLOK const char *pat|NULLOK va_list *args \
-                               |NULLOK STRLEN *msglen|NULLOK I32* utf8
-s      |bool   |vdie_common    |NULLOK const char *message|STRLEN msglen\
-                               |I32 utf8|bool warn
+s      |SV *|vdie_croak_common|NULLOK const char *pat|NULLOK va_list *args
+s      |bool   |vdie_common    |NULLOK SV *message|bool warn
 sr     |char * |write_no_mem
 #if defined(PERL_MEM_LOG) && !defined(PERL_MEM_LOG_NOIMPL)
 sn     |void   |mem_log_common |enum mem_log_type mlt|const UV n|const UV typesize \

diff --git a/embed.h b/embed.h
index 49a4b15..58e36ee 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -2517,7 +2517,7 @@
 #endif
 #endif
 #ifdef PERL_CORE
-#define die_where(a,b)         Perl_die_where(aTHX_ a,b)
+#define die_where(a)           Perl_die_where(aTHX_ a)
 #endif
 #define dounwind(a)            Perl_dounwind(aTHX_ a)
 #ifdef PERL_CORE
@@ -3416,7 +3416,7 @@
 #endif
 #define whichsig(a)            Perl_whichsig(aTHX_ a)
 #ifdef PERL_CORE
-#define write_to_stderr(a,b)   Perl_write_to_stderr(aTHX_ a,b)
+#define write_to_stderr(a)     Perl_write_to_stderr(aTHX_ a)
 #define yyerror(a)             Perl_yyerror(aTHX_ a)
 #endif
 #if defined(PERL_CORE) || defined(PERL_EXT)
@@ -4016,8 +4016,8 @@
 #ifdef PERL_CORE
 #define closest_cop(a,b)       S_closest_cop(aTHX_ a,b)
 #define mess_alloc()           S_mess_alloc(aTHX)
-#define vdie_croak_common(a,b,c,d)     S_vdie_croak_common(aTHX_ a,b,c,d)
-#define vdie_common(a,b,c,d)   S_vdie_common(aTHX_ a,b,c,d)
+#define vdie_croak_common(a,b) S_vdie_croak_common(aTHX_ a,b)
+#define vdie_common(a,b)       S_vdie_common(aTHX_ a,b)
 #define write_no_mem()         S_write_no_mem(aTHX)
 #endif
 #if defined(PERL_MEM_LOG) && !defined(PERL_MEM_LOG_NOIMPL)

diff --git a/pp_ctl.c b/pp_ctl.c
index 7d7ad1f..f314989 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1517,7 +1517,7 @@ Perl_qerror(pTHX_ SV *err)
 }
 
 OP *
-Perl_die_where(pTHX_ const char *message, STRLEN msglen)
+Perl_die_where(pTHX_ SV *msv)
 {
     dVAR;
 
@@ -1525,15 +1525,17 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
        I32 cxix;
        I32 gimme;
 
-       if (message) {
+       if (msv) {
            if (PL_in_eval & EVAL_KEEPERR) {
                 static const char prefix[] = "\t(in cleanup) ";
                SV * const err = ERRSV;
                const char *e = NULL;
                if (!SvPOK(err))
                    sv_setpvs(err,"");
-               else if (SvCUR(err) >= sizeof(prefix)+msglen-1) {
+               else if (SvCUR(err) >= sizeof(prefix)+SvCUR(msv)-1) {
                    STRLEN len;
+                   STRLEN msglen;
+                   const char* message = SvPV_const(msv, msglen);
                    e = SvPV_const(err, len);
                    e += len - msglen;
                    if (*e != *message || strNE(e,message))
@@ -1541,16 +1543,19 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
                }
                if (!e) {
                    STRLEN start;
-                   SvGROW(err, SvCUR(err)+sizeof(prefix)+msglen);
+                   SvGROW(err, SvCUR(err)+sizeof(prefix)+SvCUR(msv));
                    sv_catpvn(err, prefix, sizeof(prefix)-1);
-                   sv_catpvn(err, message, msglen);
-                   start = SvCUR(err)-msglen-sizeof(prefix)+1;
+                   sv_catsv(err, msv);
+                   start = SvCUR(err)-SvCUR(msv)-sizeof(prefix)+1;
                    Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "%s",
                                   SvPVX_const(err)+start);
                }
            }
            else {
+               STRLEN msglen;
+               const char* message = SvPV_const(msv, msglen);
                sv_setpvn(ERRSV, message, msglen);
+               SvFLAGS(ERRSV) |= SvFLAGS(msv) & SVf_UTF8;
            }
        }
 
@@ -1571,8 +1576,8 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
 
            POPBLOCK(cx,PL_curpm);
            if (CxTYPE(cx) != CXt_EVAL) {
-               if (!message)
-                   message = SvPVx_const(ERRSV, msglen);
+               STRLEN msglen;
+               const char* message = SvPVx_const( msv ? msv : ERRSV, msglen);
                PerlIO_write(Perl_error_log, (const char *)"panic: die ", 11);
                PerlIO_write(Perl_error_log, message, msglen);
                my_exit(1);
@@ -1603,10 +1608,8 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
            return cx->blk_eval.retop;
        }
     }
-    if (!message)
-       message = SvPVx_const(ERRSV, msglen);
 
-    write_to_stderr(message, msglen);
+    write_to_stderr( msv ? msv : ERRSV );
     my_failure_exit();
     /* NOTREACHED */
     return 0;

diff --git a/proto.h b/proto.h
index 87588fe..f4769a3 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -522,7 +522,7 @@ PERL_CALLCONV OP*   Perl_die(pTHX_ const char* pat, ...)
 #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
 STATIC OP*     S_vdie(pTHX_ const char* pat, va_list* args);
 #endif
-PERL_CALLCONV OP*      Perl_die_where(pTHX_ const char* message, STRLEN msglen);
+PERL_CALLCONV OP*      Perl_die_where(pTHX_ SV* msv);
 PERL_CALLCONV void     Perl_dounwind(pTHX_ I32 cxix);
 /* PERL_CALLCONV bool  Perl_do_aexec(pTHX_ SV* really, SV** mark, SV** sp)
                        __attribute__nonnull__(pTHX_2)
@@ -3742,10 +3742,10 @@ PERL_CALLCONV I32       Perl_whichsig(pTHX_ const char* sig)
 #define PERL_ARGS_ASSERT_WHICHSIG      \
        assert(sig)
 
-PERL_CALLCONV void     Perl_write_to_stderr(pTHX_ const char* message, int msglen)
+PERL_CALLCONV void     Perl_write_to_stderr(pTHX_ SV* msv)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_WRITE_TO_STDERR       \
-       assert(message)
+       assert(msv)
 
 PERL_CALLCONV int      Perl_yyerror(pTHX_ const char *const s)
                        __attribute__nonnull__(pTHX_1);
@@ -5928,8 +5928,8 @@ STATIC const COP* S_closest_cop(pTHX_ const COP *cop, const OP *o)
        assert(cop)
 
 STATIC SV*     S_mess_alloc(pTHX);
-STATIC const char *    S_vdie_croak_common(pTHX_ const char *pat, va_list *args, STRLEN *msglen, I32* utf8);
-STATIC bool    S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32 utf8, bool warn);
+STATIC SV *    S_vdie_croak_common(pTHX_ const char *pat, va_list *args);
+STATIC bool    S_vdie_common(pTHX_ SV *message, bool warn);
 STATIC char *  S_write_no_mem(pTHX)
                        __attribute__noreturn__;
 

diff --git a/util.c b/util.c
index f60f3d0..f270212 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1229,7 +1229,7 @@ Perl_vmess(pTHX_ const char *pat, va_list *args)
 }
 
 void
-Perl_write_to_stderr(pTHX_ const char* message, int msglen)
+Perl_write_to_stderr(pTHX_ SV* msv)
 {
     dVAR;
     IO *io;
@@ -1254,7 +1254,7 @@ Perl_write_to_stderr(pTHX_ const char* message, int msglen)
        PUSHMARK(SP);
        EXTEND(SP,2);
        PUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
-       mPUSHp(message, msglen);
+       PUSHs(msv);
        PUTBACK;
        call_method("PRINT", G_SCALAR);
 
@@ -1268,6 +1268,8 @@ Perl_write_to_stderr(pTHX_ const char* message, int msglen)
        dSAVED_ERRNO;
 #endif
        PerlIO * const serr = Perl_error_log;
+       STRLEN msglen;
+       const char* message = SvPVx_const(msv, msglen);
 
        PERL_WRITE_MSG_TO_CONSOLE(serr, message, msglen);
        (void)PerlIO_flush(serr);
@@ -1280,7 +1282,7 @@ Perl_write_to_stderr(pTHX_ const char* message, int msglen)
 /* Common code used by vcroak, vdie, vwarn and vwarner  */
 
 STATIC bool
-S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32 utf8, bool warn)
+S_vdie_common(pTHX_ SV *message, bool warn)
 {
     dVAR;
     HV *stash;
@@ -1308,7 +1310,7 @@ S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32 utf8, bool warn)
            *hook = NULL;
        }
        if (warn || message) {
-           msg = newSVpvn_flags(message, msglen, utf8);
+           msg = newSVsv(message);
            SvREADONLY_on(msg);
            SAVEFREESV(msg);
        }
@@ -1328,30 +1330,28 @@ S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32 utf8, bool warn)
     return FALSE;
 }
 
-STATIC const char *
-S_vdie_croak_common(pTHX_ const char* pat, va_list* args, STRLEN* msglen,
-                   I32* utf8)
+STATIC SV *
+S_vdie_croak_common(pTHX_ const char* pat, va_list* args)
 {
     dVAR;
-    const char *message;
+    SV *message;
 
     if (pat) {
        SV * const msv = vmess(pat, args);
        if (PL_errors && SvCUR(PL_errors)) {
            sv_catsv(PL_errors, msv);
-           message = SvPV_const(PL_errors, *msglen);
+           message = sv_mortalcopy(PL_errors);
            SvCUR_set(PL_errors, 0);
        }
        else
-           message = SvPV_const(msv,*msglen);
-       *utf8 = SvUTF8(msv);
+           message = msv;
     }
     else {
        message = NULL;
     }
 
     if (PL_diehook) {
-       S_vdie_common(aTHX_ message, *msglen, *utf8, FALSE);
+       S_vdie_common(aTHX_ message, FALSE);
     }
     return message;
 }
@@ -1360,14 +1360,11 @@ static OP *
 S_vdie(pTHX_ const char* pat, va_list *args)
 {
     dVAR;
-    const char *message;
-    STRLEN msglen;
-    I32 utf8 = 0;
+    SV *message;
 
-    message = vdie_croak_common(pat, args, &msglen, &utf8);
+    message = vdie_croak_common(pat, args);
 
-    PL_restartop = die_where(message, msglen);
-    SvFLAGS(ERRSV) |= utf8;
+    PL_restartop = die_where(message);
     JMPENV_JUMP(3);
     /* NOTREACHED */
     return NULL;
@@ -1402,21 +1399,16 @@ void
 Perl_vcroak(pTHX_ const char* pat, va_list *args)
 {
     dVAR;
-    const char *message;
-    STRLEN msglen;
-    I32 utf8 = 0;
+    SV *msv;
 
-    message = S_vdie_croak_common(aTHX_ pat, args, &msglen, &utf8);
+    msv = S_vdie_croak_common(aTHX_ pat, args);
 
     if (PL_in_eval) {
-       PL_restartop = die_where(message, msglen);
-       SvFLAGS(ERRSV) |= utf8;
+       PL_restartop = die_where(msv);
        JMPENV_JUMP(3);
     }
-    else if (!message)
-       message = SvPVx_const(ERRSV, msglen);
 
-    write_to_stderr(message, msglen);
+    write_to_stderr( msv ? msv : ERRSV );
     my_failure_exit();
 }
 
@@ -1467,19 +1459,16 @@ void
 Perl_vwarn(pTHX_ const char* pat, va_list *args)
 {
     dVAR;
-    STRLEN msglen;
     SV * const msv = vmess(pat, args);
-    const I32 utf8 = SvUTF8(msv);
-    const char * const message = SvPV_const(msv, msglen);
 
     PERL_ARGS_ASSERT_VWARN;
 
     if (PL_warnhook) {
-       if (vdie_common(message, msglen, utf8, TRUE))
+       if (vdie_common(msv, TRUE))
            return;
     }
 
-    write_to_stderr(message, msglen);
+    write_to_stderr(msv);
 }
 
 #if defined(PERL_IMPLICIT_CONTEXT)
@@ -1570,20 +1559,16 @@ Perl_vwarner(pTHX_ U32  err, const char* pat, va_list* args)
     PERL_ARGS_ASSERT_VWARNER;
     if (PL_warnhook == PERL_WARNHOOK_FATAL || ckDEAD(err)) {
        SV * const msv = vmess(pat, args);
-       STRLEN msglen;
-       const char * const message = SvPV_const(msv, msglen);
-       const I32 utf8 = SvUTF8(msv);
 
        if (PL_diehook) {
-           assert(message);
-           S_vdie_common(aTHX_ message, msglen, utf8, FALSE);
+           assert(msv);
+           S_vdie_common(aTHX_ msv, FALSE);
        }
        if (PL_in_eval) {
-           PL_restartop = die_where(message, msglen);
-           SvFLAGS(ERRSV) |= utf8;
+           PL_restartop = die_where(msv);
            JMPENV_JUMP(3);
        }
-       write_to_stderr(message, msglen);
+       write_to_stderr(msv);
        my_failure_exit();
     }
     else {