From: Gerard Goossen <gerard@tty.nl>
Date: Thu, 29 Oct 2009 10:05:11 +0000 (+0100)
Subject: Use of SV* instead of message, msglen, utf8 to contain error message
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7d0994e057b3340e9b0be219a07a5992e313f0f0;p=p5sagit%2Fp5-mst-13.2.git

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

diff --git a/embed.fnc b/embed.fnc
index 090b243..d107614 100644
--- 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
--- 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
--- 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
--- 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
--- 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 {