Cracked! - Re: ext/Encode/t/perlio on VMS (was Re: perl@16539)

[Nick Ing-Simmons]

Nick Ing-Simmons <[EMAIL PROTECTED]> writes:
>
>Quick fix patch to follow, followed by a more optimal one.
>

The Quick-fix broke op/stat.t's -T and -B stuff :-(

So here is more optimal one - please try on VMS !

-- 
Nick Ing-Simmons
http://www.ni-s.u-net.com/


--- perlio.c.ship       Wed May 22 21:58:42 2002
+++ perlio.c    Wed May 22 22:27:29 2002
@@ -2632,16 +2632,32 @@
 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) {
+       unread += PerlIOBase_unread(aTHX_ f, vbuf, count);
     }
+    if (PerlSIO_feof(s) && unread >= 0)
+       PerlSIO_clearerr(s);
     return unread;
 }
 
@@ -2705,8 +2721,30 @@
            return EOF;
     }
     c = PerlSIO_fgetc(stdio);
-    if (c == EOF || PerlSIO_ungetc(c, stdio) != c)
+    if (c == EOF)
        return EOF;
+
+    if (PerlIOBase(f)->tab->Set_ptrcnt != NULL) {
+       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);
+           return 0;
+       }
+    }
+
+#if defined(VMS)
+    /* An ungetc()d char is handled separately from the regular
+     * buffer, so we stuff it in the buffer ourselves.
+     */
+    *(--((*fp)->_ptr)) = (unsigned char) c;
+    (*fp)->_cnt++;
+#else
+    if (PerlSIO_ungetc(c, stdio) != c)
+       return EOF;
+#endif
     return 0;
 }
 
@@ -3161,6 +3199,9 @@
            unread += avail;
            PerlIOBase(f)->flags &= ~PERLIO_F_EOF;
        }
+    }
+    if (count) {
+       unread += PerlIOBase_unread(aTHX_ f, vbuf, count);
     }
     return unread;
 }