diff options
| -rw-r--r-- | pod/perltie.pod | 8 | ||||
| -rw-r--r-- | pp_hot.c | 5 | ||||
| -rwxr-xr-x | t/op/tiehandle.t | 31 |
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> @@ -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" } } - |