Re: [perl #49264] say behaves as just print on tied filehandle

Message-ID: <477C3594.9080302@pobox.com>

p4raw-id: //depot/perl@32873

3 files changed, 39 insertions, 5 deletions

diff --git a/pod/perltie.pod b/pod/perltie.pod
index 9ee5b2c487..162272bd74 100644
--- a/pod/perltie.pod
+++ b/pod/perltie.pod
@@ -900,12 +900,14 @@ C<syswrite> function.
 X<PRINT>
 
 This method will be triggered every time the tied handle is printed to
-with the C<print()> function.
-Beyond its self reference it also expects the list that was passed to
-the print function.
+with the C<print()> or C<say()> functions.  Beyond its self reference
+it also expects the list that was passed to the print function.
 
     sub PRINT { $r = shift; $$r++; print join($,,map(uc($_),@_)),$\ }
 
+C<say()> acts just like C<print()> except $\ will be localized to C<\n> so
+you need do nothing special to handle C<say()> in C<PRINT()>.
+
 =item PRINTF this, LIST
 X<PRINTF>
 
diff --git a/pp_hot.c b/pp_hot.c
index f5433724f5..7a71b6f79e 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -731,6 +731,11 @@ PP(pp_print)
 	*MARK = SvTIED_obj((SV*)io, mg);
 	PUTBACK;
 	ENTER;
+	if( PL_op->op_type == OP_SAY ) {
+		/* local $\ = "\n" */
+		SAVESPTR(PL_ors_sv);
+		PL_ors_sv = newSVpvs("\n");
+	}
 	call_method("PRINT", G_SCALAR);
 	LEAVE;
 	SPAGAIN;
diff --git a/t/op/tiehandle.t b/t/op/tiehandle.t
index c679c580e6..735a25c071 100755
--- a/t/op/tiehandle.t
+++ b/t/op/tiehandle.t
@@ -10,9 +10,11 @@ my $data = "";
 my @data = ();
 
 require './test.pl';
-plan(tests => 41);
+plan(tests => 50);
 
 sub compare {
+    local $Level = $Level + 1;
+
     return unless @expect;
     return ::fail() unless(@_ == @expect);
 
@@ -163,6 +165,32 @@ is($r, 1);
 }
 
 {
+    package Bar::Say;
+    use feature 'say';
+    use base qw(Implement);
+
+    my $ors;
+    sub PRINT     {
+        $ors = $\;
+        my $self = shift;
+        return $self->SUPER::PRINT(@_);
+    }
+
+    my $fh = Symbol::gensym;
+    @expect = (TIEHANDLE => 'Bar::Say');
+    ::ok( my $obj = tie *$fh, 'Bar::Say' );
+
+    local $\ = 'something';
+    @expect = (PRINT => $obj, "stuff", "and", "things");
+    ::ok( print $fh @expect[2..4] );
+    ::is( $ors, 'something' );
+    
+    ::ok( say $fh @expect[2..4] );
+    ::is( $ors, "\n",        'say sets $\ to \n in PRINT' );
+    ::is( $\,   "something", "  and it's localized" );
+}
+
+{
     # Test for change #11536
     package Foo;
     use strict;
@@ -245,4 +273,3 @@ is($r, 1);
     sub READLINE { "foobar\n" }
 }
 
-