Re: [perl #57322] perlbug AutoReply: ungetc() to :scalar might cause problems

From: "Goro Fuji" <gfuji@cpan.org>
Message-ID: <efb9c59b0807262237r62497f36g4f6d6881bb684a53@mail.gmail.com>

p4raw-id: //depot/perl@34773

diff --git a/MANIFEST b/MANIFEST
index 97705e2..278c9f0 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -965,6 +965,7 @@ ext/PerlIO/encoding/t/nolooping.t   Tests for PerlIO::encoding
 ext/PerlIO/scalar/Makefile.PL  PerlIO layer for scalars
 ext/PerlIO/scalar/scalar.pm    PerlIO layer for scalars
 ext/PerlIO/scalar/scalar.xs    PerlIO layer for scalars
+ext/PerlIO/scalar/t/scalar_ungetc.t    Tests for PerlIO layer for scalars
 ext/PerlIO/t/encoding.t                See if PerlIO encoding conversion works
 ext/PerlIO/t/fail.t            See if bad layers fail
 ext/PerlIO/t/fallback.t                See if PerlIO fallbacks work

diff --git a/ext/PerlIO/scalar/scalar.pm b/ext/PerlIO/scalar/scalar.pm
index 010182a..5188ddb 100644 (file)
--- a/ext/PerlIO/scalar/scalar.pm
+++ b/ext/PerlIO/scalar/scalar.pm
@@ -1,5 +1,5 @@
 package PerlIO::scalar;
-our $VERSION = '0.06';
+our $VERSION = '0.07';
 use XSLoader ();
 XSLoader::load 'PerlIO::scalar';
 1;

diff --git a/ext/PerlIO/scalar/scalar.xs b/ext/PerlIO/scalar/scalar.xs
index 6876b2b..d9574d7 100644 (file)
--- a/ext/PerlIO/scalar/scalar.xs
+++ b/ext/PerlIO/scalar/scalar.xs
@@ -125,17 +125,6 @@ PerlIOScalar_tell(pTHX_ PerlIO * f)
 }
 
 SSize_t
-PerlIOScalar_unread(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
-{
-    PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
-    char *dst = SvGROW(s->var, (STRLEN)s->posn + count);
-    s->posn -= count;
-    Move(vbuf, dst + s->posn, count, char);
-    SvPOK_on(s->var);
-    return count;
-}
-
-SSize_t
 PerlIOScalar_write(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
 {
     if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE) {
@@ -289,7 +278,7 @@ PERLIO_FUNCS_DECL(PerlIO_scalar) = {
     PerlIOScalar_fileno,
     PerlIOScalar_dup,
     PerlIOBase_read,
-    PerlIOScalar_unread,
+    NULL, /* unread */
     PerlIOScalar_write,
     PerlIOScalar_seek,
     PerlIOScalar_tell,

diff --git a/ext/PerlIO/scalar/t/scalar_ungetc.t b/ext/PerlIO/scalar/t/scalar_ungetc.t
new file mode 100644 (file)
index 0000000..8ca7eb2
--- /dev/null
+++ b/ext/PerlIO/scalar/t/scalar_ungetc.t
@@ -0,0 +1,36 @@
+#!perl -w\r
+use strict;\r
+use IO::Handle; # ungetc()\r
+\r
+use Test::More tests => 20;\r
+\r
+require_ok q{PerlIO::scalar};\r
+\r
+my $s = 'foo';\r
+Internals::SvREADONLY($s, 1);\r
+eval{\r
+       $s = 'bar';\r
+};\r
+like $@, qr/Modification of a read-only value/, '$s is readonly';\r
+\r
+ok open(my $io, '<', \$s), 'open';\r
+\r
+getc $io;\r
+\r
+my $a = ord 'A';\r
+\r
+diag "buffer[$s]";\r
+is $io->ungetc($a), $a, 'ungetc';\r
+diag "buffer[$s]";\r
+\r
+is getc($io), chr($a), 'getc';\r
+\r
+is $s, 'foo', '$s remains "foo"';\r
+\r
+is getc($io), 'o', 'getc/2';\r
+is getc($io), 'o', 'getc/3';\r
+is getc($io), undef, 'getc/4';\r
+\r
+for my $c($a .. ($a+10)){\r
+       is $io->ungetc($c), $c, "ungetc($c)";\r
+}
\ No newline at end of file