allow die $ref

Tim Bunce wrote:
> 
> Does
>         eval { die $ref };
>         die if $@;
> 
> propagate the original ref?

No, but here is a new patch against perl5.004_04-m1 which does

> Are 'we' happy to loose the "\n...propagated at ..." functionality
> of a die without arguments when $@ contains a ref? I guess it's the
> only reasonable way to go.

Well this is what started off the definition of Error.pm. The thought
was that maybe that if $ref is an object it should support a given
API. Then we could have methods for propagate and stringify which
perl would call at appropriate times.

Credited: Tim Bunce <Tim.Bunce@ig.co.uk>
Credited: Tim.Bunce@ig.co.uk (Tim Bunce) (Tim Bunce)

p5p-msgid: 355C3E67.AF25B9F7@ti.com
Credited: Tim Bunce <Tim.Bunce@ig.co.uk>
Credited: Tim.Bunce@ig.co.uk (Tim Bunce) (Tim Bunce)

3 files changed, 46 insertions, 28 deletions

diff --git a/pp_ctl.c b/pp_ctl.c
index ec8500b918..0adc6a97aa 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1035,28 +1035,32 @@ char *message;
 	I32 gimme;
 	SV **newsp;
 
-	if (in_eval & 4) {
-	    SV **svp;
-	    STRLEN klen = strlen(message);
-	    
-	    svp = hv_fetch(GvHV(errgv), message, klen, TRUE);
-	    if (svp) {
-		if (!SvIOK(*svp)) {
-		    static char prefix[] = "\t(in cleanup) ";
-		    SV *err = GvSV(errgv);
-		    sv_upgrade(*svp, SVt_IV);
-		    (void)SvIOK_only(*svp);
-		    if (!SvPOK(err))
-			sv_setpv(err,"");
-		    SvGROW(err, SvCUR(err)+sizeof(prefix)+klen);
-		    sv_catpvn(err, prefix, sizeof(prefix)-1);
-		    sv_catpvn(err, message, klen);
+	if(message) {
+	    if (in_eval & 4) {
+		SV **svp;
+		STRLEN klen = strlen(message);
+
+		svp = hv_fetch(GvHV(errgv), message, klen, TRUE);
+		if (svp) {
+		    if (!SvIOK(*svp)) {
+			static char prefix[] = "\t(in cleanup) ";
+			SV *err = GvSV(errgv);
+			sv_upgrade(*svp, SVt_IV);
+			(void)SvIOK_only(*svp);
+			if (!SvPOK(err))
+			    sv_setpv(err,"");
+			SvGROW(err, SvCUR(err)+sizeof(prefix)+klen);
+			sv_catpvn(err, prefix, sizeof(prefix)-1);
+			sv_catpvn(err, message, klen);
+		    }
+		    sv_inc(*svp);
 		}
-		sv_inc(*svp);
 	    }
+	    else
+		sv_setpv(GvSV(errgv), message);
 	}
 	else
-	    sv_setpv(GvSV(errgv), message);
+	    message = SvPVx(GvSV(errgv),na);
 	
 	cxix = dopoptoeval(cxstack_ix);
 	if (cxix >= 0) {
diff --git a/pp_sys.c b/pp_sys.c
index 27615690c7..18a8968663 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -293,6 +293,8 @@ PP(pp_die)
 {
     dSP; dMARK;
     char *tmps;
+    SV *tmpsv = Nullsv;
+    char *pat = "%s";
     if (SP - MARK != 1) {
 	dTARGET;
 	do_join(TARG, &sv_no, MARK, SP);
@@ -300,18 +302,26 @@ PP(pp_die)
 	SP = MARK + 1;
     }
     else {
-	tmps = SvPV(TOPs, na);
+	tmpsv = TOPs;
+	tmps = SvROK(tmpsv) ? Nullch : SvPV(TOPs, na);
     }
     if (!tmps || !*tmps) {
 	SV *error = GvSV(errgv);
 	(void)SvUPGRADE(error, SVt_PV);
-	if (SvPOK(error) && SvCUR(error))
-	    sv_catpv(error, "\t...propagated");
-	tmps = SvPV(error, na);
+	if(tmpsv ? SvROK(tmpsv) : SvROK(error)) {
+	    if(tmpsv)
+		SvSetSV(error,tmpsv);
+	    pat = Nullch;
+	}
+	else {
+	    if (SvPOK(error) && SvCUR(error))
+		sv_catpv(error, "\t...propagated");
+	    tmps = SvPV(error, na);
+	}
     }
     if (!tmps || !*tmps)
 	tmps = "Died";
-    DIE("%s", tmps);
+    DIE(pat, tmps);
 }
 
 /* I/O. */
diff --git a/util.c b/util.c
index 0eaa18feed..0a461a2317 100644
--- a/util.c
+++ b/util.c
@@ -1183,7 +1183,7 @@ die(pat, va_alist)
 #else
     va_start(args);
 #endif
-    message = mess(pat, &args);
+    message = pat ? mess(pat, &args) : Nullch;
     va_end(args);
 
     if (diehook) {
@@ -1199,10 +1199,14 @@ die(pat, va_alist)
 	    SV *msg;
 
 	    ENTER;
-	    msg = newSVpv(message, 0);
-	    SvREADONLY_on(msg);
-	    SAVEFREESV(msg);
-
+	    if(message) {
+		msg = newSVpv(message, 0);
+		SvREADONLY_on(msg);
+		SAVEFREESV(msg);
+	    }
+	    else {
+		msg = GvSV(errgv);
+	    }
 	    PUSHMARK(sp);
 	    XPUSHs(msg);
 	    PUTBACK;