From d1d7a15d2d5a0a628a4646ff58aaf00222c7ed58 Mon Sep 17 00:00:00 2001
From: Nicholas Clark <nick@ccl4.org>
Date: Thu, 13 Jan 2011 17:04:14 +0000
Subject: [PATCH] In Perl_write_to_stderr(), use Perl_magic_methcall() if
 STDERR is tied.

Add a flag G_WRITING_TO_STDERR to signal that Perl_magic_methcall() needs to
localise PL_stderrgv to NULL, and save/free temps, inside its ENTER/LEAVE
pair.
---
 cop.h  |  2 ++
 mg.c   | 11 +++++++++++
 util.c | 24 ++----------------------
 3 files changed, 15 insertions(+), 22 deletions(-)

diff --git a/cop.h b/cop.h
index 5b5a79e..2dc67cb 100644
--- a/cop.h
+++ b/cop.h
@@ -1064,6 +1064,8 @@ L<perlcall>.
 #define G_UNDEF_FILL  512	/* Fill the stack with &PL_sv_undef
 				   A special case for UNSHIFT in
 				   Perl_magic_methcall().  */
+#define G_WRITING_TO_STDERR 1024 /* Perl_write_to_stderr() is calling
+				    Perl_magic_methcall().  */
 
 /* flag bits for PL_in_eval */
 #define EVAL_NULL	0	/* not in an eval */
diff --git a/mg.c b/mg.c
index a6912a0..efc4d6e 100644
--- a/mg.c
+++ b/mg.c
@@ -1740,6 +1740,15 @@ Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags,
     PERL_ARGS_ASSERT_MAGIC_METHCALL;
 
     ENTER;
+
+    if (flags & G_WRITING_TO_STDERR) {
+	SAVETMPS;
+
+	save_re_context();
+	SAVESPTR(PL_stderrgv);
+	PL_stderrgv = NULL;
+    }
+
     PUSHSTACKi(PERLSI_MAGIC);
     PUSHMARK(SP);
 
@@ -1769,6 +1778,8 @@ Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags,
 	    ret = *PL_stack_sp--;
     }
     POPSTACK;
+    if (flags & G_WRITING_TO_STDERR)
+	FREETMPS;
     LEAVE;
     return ret;
 }
diff --git a/util.c b/util.c
index e9bd742..67a5cbe 100644
--- a/util.c
+++ b/util.c
@@ -1411,28 +1411,8 @@ Perl_write_to_stderr(pTHX_ SV* msv)
     if (PL_stderrgv && SvREFCNT(PL_stderrgv) 
 	&& (io = GvIO(PL_stderrgv))
 	&& (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) 
-    {
-	dSP;
-	ENTER;
-	SAVETMPS;
-
-	save_re_context();
-	SAVESPTR(PL_stderrgv);
-	PL_stderrgv = NULL;
-
-	PUSHSTACKi(PERLSI_MAGIC);
-
-	PUSHMARK(SP);
-	EXTEND(SP,2);
-	PUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
-	PUSHs(msv);
-	PUTBACK;
-	call_method("PRINT", G_SCALAR | G_DISCARD);
-
-	POPSTACK;
-	FREETMPS;
-	LEAVE;
-    }
+	Perl_magic_methcall(aTHX_ MUTABLE_SV(io), mg, "PRINT",
+			    G_SCALAR | G_DISCARD | G_WRITING_TO_STDERR, 1, msv);
     else {
 #ifdef USE_SFIO
 	/* SFIO can really mess with your errno */
-- 
1.8.3.1