Convert tied PRINT to using Perl_tied_method()

Add a flag TIED_METHOD_SAY to Perl_tied_method(), to allow tied PRINT to
effect C<local $\ = "\n";> within the ENTER/LEAVE pair of Perl_tied_method().

diff --git a/pp.h b/pp.h
index 3070476..6903069 100644 (file)
--- a/pp.h
+++ b/pp.h
@@ -497,6 +497,7 @@ True if this op will be the return value of an lvalue subroutine
    architecture can generate more efficient instructions.  */
 #  define TIED_METHOD_MORTALIZE_NOT_NEEDED     0x04
 #  define TIED_METHOD_ARGUMENTS_ON_STACK       0x08
+#  define TIED_METHOD_SAY                      0x10
 #endif
 
 /*

diff --git a/pp_hot.c b/pp_hot.c
index ce465e7..26e8b69 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -729,22 +729,11 @@ PP(pp_print)
            Move(MARK, MARK + 1, (SP - MARK) + 1, SV*);
            ++SP;
        }
-       PUSHMARK(MARK - 1);
-       *MARK = SvTIED_obj(MUTABLE_SV(io), mg);
-       PUTBACK;
-       ENTER_with_name("call_PRINT");
-       if( PL_op->op_type == OP_SAY ) {
-               /* local $\ = "\n" */
-               SAVEGENERICSV(PL_ors_sv);
-               PL_ors_sv = newSVpvs("\n");
-       }
-       call_method("PRINT", G_SCALAR);
-       LEAVE_with_name("call_PRINT");
-       SPAGAIN;
-       MARK = ORIGMARK + 1;
-       *MARK = *SP;
-       SP = MARK;
-       RETURN;
+       return Perl_tied_method(aTHX_ "PRINT", mark - 1, MUTABLE_SV(io),
+                               mg,
+                               (G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK
+                                | (PL_op->op_type == OP_SAY
+                                   ? TIED_METHOD_SAY : 0)), sp - mark);
     }
     if (!io) {
         if ( gv && GvEGVx(gv) && (io = GvIO(GvEGV(gv)))

diff --git a/pp_sys.c b/pp_sys.c
index a0ed985..8e156b5 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -516,6 +516,7 @@ Perl_tied_method(pTHX_ const char *const methname, SV **sp, SV *const sv,
     /* Ensure that our flag bits do not overlap.  */
     assert((TIED_METHOD_MORTALIZE_NOT_NEEDED & G_WANT) == 0);
     assert((TIED_METHOD_ARGUMENTS_ON_STACK & G_WANT) == 0);
+    assert((TIED_METHOD_SAY & G_WANT) == 0);
 
     PUSHMARK(sp);
     PUSHs(SvTIED_obj(sv, mg));
@@ -538,6 +539,11 @@ Perl_tied_method(pTHX_ const char *const methname, SV **sp, SV *const sv,
 
     PUTBACK;
     ENTER_with_name("call_tied_method");
+    if (flags & TIED_METHOD_SAY) {
+       /* local $\ = "\n" */
+       SAVEGENERICSV(PL_ors_sv);
+       PL_ors_sv = newSVpvs("\n");
+    }
     call_method(methname, flags & G_WANT);
     LEAVE_with_name("call_tied_method");
     return NORMAL;