X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=14a48c653ddb72eaa99cec35d34b525da03efa50;hb=8e0fc1cdff8c4d07f11a5b0bd5056e1acbe2a68a;hp=9dbd52522c6da84457362bf867202b8ea3653044;hpb=cb36c7826069e46f7a72e79cb6e038763e4c7ca8;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_ctl.c b/pp_ctl.c
index 9dbd525..14a48c6 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1224,6 +1224,9 @@ OP *
 Perl_die_where(pTHX_ char *message, STRLEN msglen)
 {
     STRLEN n_a;
+    IO *io;
+    MAGIC *mg;
+
     if (PL_in_eval) {
 	I32 cxix;
 	register PERL_CONTEXT *cx;
@@ -1303,7 +1306,19 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen)
     }
     if (!message)
 	message = SvPVx(ERRSV, msglen);
-    {
+
+    /* if STDERR is tied, print to it instead */
+    if (PL_stderrgv && (io = GvIOp(PL_stderrgv))
+	&& (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) {
+	dSP; ENTER;
+	PUSHMARK(SP);
+	XPUSHs(SvTIED_obj((SV*)io, mg));
+	XPUSHs(sv_2mortal(newSVpvn(message, msglen)));
+	PUTBACK;
+	call_method("PRINT", G_SCALAR);
+	LEAVE;
+    }
+    else {
 #ifdef USE_SFIO
 	/* SFIO can really mess with your errno */
 	int e = errno;