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.

diff --git a/cop.h b/cop.h
index 5b5a79e..2dc67cb 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 */