From: Goro Fuji <gfuji@cpan.org>
Date: Sun, 27 Jul 2008 14:37:45 +0000 (+0900)
Subject: Re: [perl #57322] perlbug AutoReply: ungetc() to :scalar might cause problems
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3ff3a8b6a30dcb820ca4496cf2621960aa48a0c5;p=p5sagit%2Fp5-mst-13.2.git

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