From: Nick Ing-Simmons <nik@tiuk.ti.com>
Date: Wed, 22 May 2002 20:59:22 +0000 (+0000)
Subject: Fix for ungetc() issues flagged by ext/Encode/t/perlio.t on VMS.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=936797854c70e5d5b5cc5ea02e2c3cbeffef5869;p=p5sagit%2Fp5-mst-13.2.git

Fix for ungetc() issues flagged by ext/Encode/t/perlio.t on VMS.
ungetc() and buffer snooping may not mix. So use buffer snoop
hooks to avoid ungetc() where available.
unread() falls back to using :pending layer, and fill has
VMS specific code (which should not get used) or ungetc()
which should work.

p4raw-id: //depot/perlio@16739
---

diff --git a/perlio.c b/perlio.c
index f5d528e..8cfd02f 100644
--- a/perlio.c
+++ b/perlio.c
@@ -2632,16 +2632,32 @@ PerlIOStdio_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 SSize_t
 PerlIOStdio_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
-    FILE *s = PerlIOSelf(f, PerlIOStdio)->stdio;
-    STDCHAR *buf = ((STDCHAR *) vbuf) + count - 1;
     SSize_t unread = 0;
-    while (count > 0) {
-	int ch = *buf-- & 0xff;
-	if (PerlSIO_ungetc(ch, s) != ch)
-	    break;
-	unread++;
-	count--;
+    FILE *s = PerlIOSelf(f, PerlIOStdio)->stdio;
+
+    if (PerlIO_fast_gets(f)) {
+	STDCHAR *buf = ((STDCHAR *) vbuf) + count;
+	STDCHAR *base = PerlIO_get_base(f);
+	SSize_t cnt   = PerlIO_get_cnt(f);
+	STDCHAR *ptr  = PerlIO_get_ptr(f);
+	SSize_t avail = ptr - base;
+	if (avail > 0) {
+	    if (avail > count) {
+		avail = count;
+	    }
+	    ptr -= avail;
+	    Move(buf-avail,ptr,avail,STDCHAR);
+	    count -= avail;
+	    unread += avail;
+	    PerlIO_set_ptrcnt(f,ptr,cnt+avail);
+	}
+    }
+
+    if (count > 0) {
+	unread += PerlIOBase_unread(aTHX_ f, vbuf, count);
     }
+    if (PerlSIO_feof(s) && unread >= 0)
+	PerlSIO_clearerr(s);
     return unread;
 }
 
@@ -2693,24 +2709,6 @@ PerlIOStdio_flush(pTHX_ PerlIO *f)
 }
 
 IV
-PerlIOStdio_fill(pTHX_ PerlIO *f)
-{
-    FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
-    int c;
-    /*
-     * fflush()ing read-only streams can cause trouble on some stdio-s
-     */
-    if ((PerlIOBase(f)->flags & PERLIO_F_CANWRITE)) {
-	if (PerlSIO_fflush(stdio) != 0)
-	    return EOF;
-    }
-    c = PerlSIO_fgetc(stdio);
-    if (c == EOF || PerlSIO_ungetc(c, stdio) != c)
-	return EOF;
-    return 0;
-}
-
-IV
 PerlIOStdio_eof(pTHX_ PerlIO *f)
 {
     return PerlSIO_feof(PerlIOSelf(f, PerlIOStdio)->stdio);
@@ -2807,8 +2805,62 @@ PerlIOStdio_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt)
 #endif                          /* STDIO_CNT_LVALUE */
 }
 
+
 #endif
 
+IV
+PerlIOStdio_fill(pTHX_ PerlIO *f)
+{
+    FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
+    int c;
+    /*
+     * fflush()ing read-only streams can cause trouble on some stdio-s
+     */
+    if ((PerlIOBase(f)->flags & PERLIO_F_CANWRITE)) {
+	if (PerlSIO_fflush(stdio) != 0)
+	    return EOF;
+    }
+    c = PerlSIO_fgetc(stdio);
+    if (c == EOF)
+	return EOF;
+
+#if (defined(STDIO_PTR_LVALUE) && (defined(STDIO_CNT_LVALUE) || defined(STDIO_PTR_LVAL_SETS_CNT)))
+    if (PerlIO_fast_gets(f)) {
+	/* Fake ungetc() to the real buffer in case system's ungetc
+	   goes elsewhere
+	 */
+	STDCHAR *base = (STDCHAR*)PerlSIO_get_base(stdio);
+	SSize_t cnt   = PerlSIO_get_cnt(stdio);
+	STDCHAR *ptr  = (STDCHAR*)PerlSIO_get_ptr(stdio);
+	if (ptr == base+1) {
+	    *--ptr = (STDCHAR) c;
+	    PerlIOStdio_set_ptrcnt(aTHX_ f,ptr,cnt+1);
+	    if (PerlSIO_feof(stdio))
+		PerlSIO_clearerr(stdio);
+	    return 0;
+	}
+    }
+#endif
+
+#if defined(VMS)
+    /* An ungetc()d char is handled separately from the regular
+     * buffer, so we stuff it in the buffer ourselves.
+     * Should never get called as should hit code above
+     */
+    *(--((*fp)->_ptr)) = (unsigned char) c;
+    (*fp)->_cnt++;
+#else
+    /* If buffer snoop scheme above fails fall back to
+       using ungetc (but why did "fill" get called?).
+     */
+    if (PerlSIO_ungetc(c, stdio) != c)
+	return EOF;
+#endif
+    return 0;
+}
+
+
+
 PerlIO_funcs PerlIO_stdio = {
     "stdio",
     sizeof(PerlIOStdio),
@@ -3162,6 +3214,9 @@ PerlIOBuf_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 	    PerlIOBase(f)->flags &= ~PERLIO_F_EOF;
 	}
     }
+    if (count > 0) {
+	unread += PerlIOBase_unread(aTHX_ f, vbuf, count);
+    }
     return unread;
 }