In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/4e86d35098d1785c36619cff949bf432fcc6022a?hp=f46711e6b81e1fe70fdb53ed61523de90d0a226b>
- Log ----------------------------------------------------------------- commit 4e86d35098d1785c36619cff949bf432fcc6022a Author: Josh ben Jore <[email protected]> Date: Wed Jul 14 22:08:24 2010 -0700 [perl #72729] Test appending sv_gets for ascii/utf8 in target and handle M t/op/readline.t commit 7a0f084344ee57be9ab78e3cc4400f517de4e10e Author: Josh ben Jore <[email protected]> Date: Wed Jul 14 22:06:16 2010 -0700 [perl #72729] TODO for aborted readline() returning '' instead of undef M t/op/readline.t commit 05dee287818768241f07710b93adfb5d0b438ff3 Author: Josh ben Jore <[email protected]> Date: Wed Jul 14 22:02:28 2010 -0700 [perl #72729] Truncate sv_gets(sv) only when not appending to a string M sv.c ----------------------------------------------------------------------- Summary of changes: sv.c | 4 +++- t/op/readline.t | 55 ++++++++++++++++++++++++++++++++++++++++++++++++++++--- 2 files changed, 55 insertions(+), 4 deletions(-) diff --git a/sv.c b/sv.c index a069b09..f555fc1 100644 --- a/sv.c +++ b/sv.c @@ -7086,7 +7086,9 @@ Perl_sv_gets(pTHX_ register SV *const sv, register PerlIO *const fp, I32 append) } SvPOK_only(sv); - SvCUR_set(sv,0); + if (!append) { + SvCUR_set(sv,0); + } if (PerlIO_isutf8(fp)) SvUTF8_on(sv); diff --git a/t/op/readline.t b/t/op/readline.t index 74fcafc..1a57906 100644 --- a/t/op/readline.t +++ b/t/op/readline.t @@ -6,7 +6,7 @@ BEGIN { require './test.pl'; } -plan tests => 20; +plan tests => 25; # [perl #19566]: sv_gets writes directly to its argument via # TARG. Test that we respect SvREADONLY. @@ -167,14 +167,63 @@ SKIP: { # make the value valid but before it starts read(). my $once = test_eintr_readline( $in, 0 ); my $twice = test_eintr_readline( $in, 1 ); - is( $once, "once\n", "readline read first line ok" ); + is( $once, "once\n", "readline read first line ok" ); + isnt( $twice, "once\n", "readline didn't re-return things when interrupted" ); TODO: { local our $TODO = "bad readline returns '', not undef"; - is( $twice, undef, "readline didn't return first line again" ); + is( $twice, undef, "readline returned undef when interrupted" ); } } +{ + my $line = 'ascii'; + my ( $in, $out ); + pipe $in, $out; + binmode $in; + binmode $out; + syswrite $out, "...\n"; + $line .= readline $in; + + is( $line, "ascii...\n", 'Appending from ascii to ascii' ); +} + +{ + my $line = "\x{2080} utf8"; + my ( $in, $out ); + pipe $in, $out; + binmode $out; + binmode $in; + syswrite $out, "...\n"; + $line .= readline $in; + + is( $line, "\x{2080} utf8...\n", 'Appending from ascii to utf8' ); +} + +{ + my $line = 'ascii'; + my ( $in, $out ); + pipe $in, $out; + binmode $out, ':utf8'; + binmode $in, ':utf8'; + syswrite $out, "...\n"; + $line .= readline $in; + + is( $line, "ascii...\n", 'Appending from utf8 to ascii' ); +} + +{ + my $line = "\x{2080} utf8";; + my ( $in, $out ); + pipe $in, $out; + binmode $out, ':utf8'; + binmode $in, ':utf8'; + syswrite $out, "\x{2080}...\n"; + $line .= readline $in; + + is( $line, "\x{2080} utf8\x{2080}...\n", 'appending from utf to utf8' ); +} + my $obj = bless []; $obj .= <DATA>; like($obj, qr/main=ARRAY.*world/, 'rcatline and refs'); -- Perl5 Master Repository
