diff options
author | Anno Siegel <anno4000@lublin.zrz.tu-berlin.de> | 2013-10-23 18:06:45 +0100 |
---|---|---|
committer | David Mitchell <davem@iabyn.com> | 2013-10-23 18:06:45 +0100 |
commit | 2cf89ea7ef6ced6b38263ec224d4d1049bdf3cc0 (patch) | |
tree | ff42ca28dae61f60dfc0bf4dbdd5b0067edea822 /lib/Tie | |
parent | 7a6da24c189d4507eab9c21153e8c11d42d9f795 (diff) | |
download | perl-2cf89ea7ef6ced6b38263ec224d4d1049bdf3cc0.tar.gz |
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 ]
Diffstat (limited to 'lib/Tie')
-rw-r--r-- | lib/Tie/Handle/stdhandle.t | 39 | ||||
-rw-r--r-- | lib/Tie/StdHandle.pm | 1 |
2 files changed, 33 insertions, 7 deletions
diff --git a/lib/Tie/Handle/stdhandle.t b/lib/Tie/Handle/stdhandle.t index ff2a18bec3..d00ab84e22 100644 --- 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 9192b2e5ee..f7750fd8e6 100644 --- 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]) } |