Tie::StdHandle appends extra copies of $\ to output

[perl #120202]

The following code demonstrates the problem:

    use Tie::Handle;

    my $out = do { no warnings 'once'; \ local *HANDLE };
    tie *$out, 'Tie::StdHandle', '>&', \ *STDOUT or die;

    $\ = "haha\n";
    print $out "hihi\n";

which prints

    hihi
    haha
    haha

The string in $\ has been added twice, once explicitly by
Tie::Handle::PRINT and another time implicitly by the use of
(CORE::) print in Tie::StdHandle::WRITE.

The bug also affects the use of say() with tied handles where a spurious
newline is added by the same effect.

[ test added by davem ]

diff --git a/lib/Tie/Handle/stdhandle.t b/lib/Tie/Handle/stdhandle.t
index ff2a18b..d00ab84 100644 (file)
--- a/lib/Tie/Handle/stdhandle.t
+++ b/lib/Tie/Handle/stdhandle.t
@@ -5,7 +5,7 @@ BEGIN {
     @INC = '../lib';
 }
 
-use Test::More tests => 19;
+use Test::More tests => 25;
 
 use_ok('Tie::StdHandle');
 
@@ -22,25 +22,50 @@ ok(binmode($f), "binmode")
 
 ok(-f "afile", "-f afile");
 
-ok(print($f "SomeData\n"), "print");
+# write some lines
+
+ok(print($f "SomeData\n"), "print SomeData");    # line 1
 is(tell($f), 9, "tell");
-ok(printf($f "Some %d value\n",1234), "printf");
+ok(printf($f "Some %d value\n",1234), "printf"); # line 2
+ok(print($f "ABCDEF\n"), "print ABCDEF");        # line 3
+{
+    local $\ = "X\n";
+    ok(print($f "rhubarb"), "print rhubarb");    # line 4
+}
+
+# read some lines back
+
 ok(seek($f,0,0), "seek");
 
+# line 1
+#
 $b = <$f>;
 is($b, "SomeData\n", "b eq SomeData");
 ok(!eof($f), "!eof");
 
+#line 2
+
 is(read($f,($b=''),4), 4, "read(4)");
 is($b, 'Some', "b eq Some");
 is(getc($f), ' ', "getc");
-
 $b = <$f>;
-ok(eof($f), "eof");
-ok(seek($f,0,0), "seek");
+is($b, "1234 value\n", "b eq 1234 value");
+ok(!eof($f), "eof");
+
+# line 3
+
 is(read($f,($b='scrinches'),4,4), 4, "read(4,4)"); # with offset
-is($b, 'scriSome', "b eq scriSome");
+is($b, 'scriABCD', "b eq scriABCD");
+$b = <$f>;
+is($b, "EF\n", "EF");
+ok(!eof($f), "eof");
+
+# line 4
 
+$b = <$f>;
+is($b, "rhubarbX\n", "b eq rhubarbX");
+
+ok(eof($f), "eof");
 ok(close($f), "close");
 
 unlink("afile");

diff --git a/lib/Tie/StdHandle.pm b/lib/Tie/StdHandle.pm
index 9192b2e..f7750fd 100644 (file)
--- a/lib/Tie/StdHandle.pm
+++ b/lib/Tie/StdHandle.pm
@@ -64,6 +64,7 @@ sub GETC     { getc($_[0]) }
 sub WRITE
 {
  my $fh = $_[0];
+ local $\; # don't print any line terminator
  print $fh substr($_[1],0,$_[2])
 }