In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/395717c5b9c52fd284ac252ca655bbe867b36062?hp=85e0be81e1d8f65b3262d44347a85ba9cb6bd76f>
- Log ----------------------------------------------------------------- commit 395717c5b9c52fd284ac252ca655bbe867b36062 Author: Karl Williamson <[email protected]> Date: Sat Feb 2 08:41:39 2013 -0700 dist/IO/IO.xs: Silence compiler warning This variable is unused, doesn't need to be declared. M dist/IO/IO.xs commit 62ba9123033beb0f19ee9d28c9d1cc6b3bf57e46 Author: Karl Williamson <[email protected]> Date: Sun Feb 17 14:59:39 2013 -0700 Tests for [perl #116322] M dist/IO/t/io_utf8.t commit 10e621bc35cb48b15b69b5a57242ff004f7455dc Author: Christian Hansen <[email protected]> Date: Sun Feb 17 14:50:30 2013 -0700 PATCH: [perl #116322]: getc() and ungetc() with unicode failure ungetc() had no knowledge of UTF-8. This patch adds it. The committer fleshed out the author's code to make a patch, making a few small changes. M dist/IO/IO.pm M dist/IO/IO.xs commit f10c05c1d5f850f4bfb45f5d10409f4b2f3cfb2f Author: Karl Williamson <[email protected]> Date: Sun Feb 17 14:46:29 2013 -0700 Some tests for [perl #112244] Leon Timmermans is short of tuits right now, so I added these tests for his patch. Since I don't really know what I'm doing here, other tests should eventually be added by someone who does know. M t/io/crlf.t commit ec1da995fb927cb6d590ede4756eae4e266d82b6 Author: Leon Timmermans <[email protected]> Date: Thu Jul 5 16:17:44 2012 +0200 PATCH [perl #112244] :crlf currently doesn't fall back on :pending the way :perlio does when the unread data doesn't fit into its own buffer. Instead it just rejects them. This patch resolves that. Tests are coming in a future commit The committer added a cast to get it to compile on Win32, and silence a gcc warning on Linux M perlio.c ----------------------------------------------------------------------- Summary of changes: dist/IO/IO.pm | 2 +- dist/IO/IO.xs | 34 ++++++++++++++++++++++++++++------ dist/IO/t/io_utf8.t | 13 ++++++++++++- perlio.c | 2 ++ t/io/crlf.t | 14 +++++++++++++- 5 files changed, 56 insertions(+), 9 deletions(-) diff --git a/dist/IO/IO.pm b/dist/IO/IO.pm index 522aaab..2e021c4 100644 --- a/dist/IO/IO.pm +++ b/dist/IO/IO.pm @@ -7,7 +7,7 @@ use Carp; use strict; use warnings; -our $VERSION = "1.26"; +our $VERSION = "1.27"; XSLoader::load 'IO', $VERSION; sub import { diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs index 085db54..c603456 100644 --- a/dist/IO/IO.xs +++ b/dist/IO/IO.xs @@ -327,14 +327,38 @@ MODULE = IO PACKAGE = IO::Handle PREFIX = f int ungetc(handle, c) InputStream handle - int c + SV * c CODE: - if (handle) + if (handle) { #ifdef PerlIO - RETVAL = PerlIO_ungetc(handle, c); + UV v; + + if ((SvIOK_notUV(c) && SvIV(c) < 0) || (SvNOK(c) && SvNV(c) < 0.0)) + croak("Negative character number in ungetc()"); + + v = SvUV(c); + if (NATIVE_IS_INVARIANT(v) || (v <= 0xFF && !PerlIO_isutf8(handle))) + RETVAL = PerlIO_ungetc(handle, (int)v); + else { + U8 buf[UTF8_MAXBYTES + 1], *end; + Size_t len; + + if (!PerlIO_isutf8(handle)) + croak("Wide character number in ungetc()"); + + /* This doesn't warn for non-chars, surrogate, and + * above-Unicodes */ + end = uvchr_to_utf8_flags(buf, v, 0); + len = end - buf; + if (PerlIO_unread(handle, &buf, len) == len) + XSRETURN_UV(v); + else + RETVAL = EOF; + } #else - RETVAL = ungetc(c, handle); + RETVAL = ungetc((int)SvIV(c), handle); #endif + } else { RETVAL = -1; errno = EINVAL; @@ -489,8 +513,6 @@ fsync(arg) SV * _create_getline_subs(const char *code) - PREINIT: - SV *ret; CODE: OP *(*io_old_ck_lineseq)(pTHX_ OP *) = PL_check[OP_LINESEQ]; PL_check[OP_LINESEQ] = io_ck_lineseq; diff --git a/dist/IO/t/io_utf8.t b/dist/IO/t/io_utf8.t index 53c209d..339e278 100644 --- a/dist/IO/t/io_utf8.t +++ b/dist/IO/t/io_utf8.t @@ -9,7 +9,9 @@ BEGIN { require($ENV{PERL_CORE} ? "../../t/test.pl" : "./t/test.pl"); -plan(tests => 5); +my $buf_size_count = 8200; # Above default buffer size of 8192 + +plan(tests => 5 + 2 * $buf_size_count); my $io; @@ -24,6 +26,15 @@ undef $io; $io = IO::File->new; ok($io->open("io_utf8", "<:utf8"), "open <:utf8"); is(ord(<$io>), 256, "readline chr(256)"); + +for my $i (0 .. $buf_size_count - 1) { + is($io->ungetc($i), $i, "ungetc of $i returns itself"); +} + +for (my $i = $buf_size_count - 1; $i >= 0; $i--) { + is(ord($io->getc()), $i, "getc gets back $i"); +} + undef $io; END { diff --git a/perlio.c b/perlio.c index 5de5e65..097bc49 100644 --- a/perlio.c +++ b/perlio.c @@ -4571,6 +4571,8 @@ PerlIOCrlf_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count) } } } + if (count > 0) + unread += PerlIOBase_unread(aTHX_ f, (const STDCHAR *) vbuf + unread, count); return unread; } } diff --git a/t/io/crlf.t b/t/io/crlf.t index ff0f208..1e93ee0 100644 --- a/t/io/crlf.t +++ b/t/io/crlf.t @@ -12,8 +12,10 @@ use Config; my $file = tempfile(); +my $ungetc_count = 8200; # Somewhat over the likely buffer size + { - plan(tests => 16); + plan(tests => 16 + 2 * $ungetc_count); ok(open(FOO,">:crlf",$file)); ok(print FOO 'a'.((('a' x 14).qq{\n}) x 2000) || close(FOO)); ok(open(FOO,"<:crlf",$file)); @@ -42,6 +44,16 @@ my $file = tempfile(); $/ = "\n"; $s = <$fh>.<$fh>; is($s, "\nxxy\n"); + + for my $i (0 .. $ungetc_count - 1) { + my $j = $i % 256; + is($fh->ungetc($j), $j, "ungetc of $j returns itself"); + } + + for (my $i = $ungetc_count - 1; $i >= 0; $i--) { + my $j = $i % 256; + is(ord($fh->getc()), $j, "getc gets back $j"); + } } ok(close(FOO)); -- Perl5 Master Repository
