X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perlio.c;h=e1730c8ac397a79a880c199e69d20c66bcecd277;hb=055bb491aa1c61403cb7de2ea930a89a362e1807;hp=c7ea8f1989f5d46e0bd1d8d5b3d52c58e720c092;hpb=601f2d16e592dad4a4b6a344fbe935aa06230d2e;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perlio.c b/perlio.c
index c7ea8f1..e1730c8 100644
--- a/perlio.c
+++ b/perlio.c
@@ -504,7 +504,7 @@ PerlIO_find_layer(pTHX_ const char *name, STRLEN len, int load)
  for (i=0; i < PerlIO_known_layers->cur; i++)
   {
    PerlIO_funcs *f = PerlIO_known_layers->array[i].funcs;
-   if (strEQ(f->name,name))
+   if (memEQ(f->name,name,len))
     {
      PerlIO_debug("%.*s => %p\n",(int)len,name,f);
      return f;
@@ -754,7 +754,7 @@ PerlIO_layer_fetch(pTHX_ PerlIO_list_t *av,IV n,PerlIO_funcs *def)
 {
  if (n >= 0 && n < av->cur)
   {
-   PerlIO_debug("Layer %ld is %s\n",n,av->array[n].funcs->name);
+   PerlIO_debug("Layer %"IVdf" is %s\n",n,av->array[n].funcs->name);
    return av->array[n].funcs;
   }
  if (!def)
@@ -771,7 +771,7 @@ PerlIO_default_layers(pTHX)
    PerlIO_funcs *osLayer = &PerlIO_unix;
    PerlIO_def_layerlist  = PerlIO_list_alloc();
    PerlIO_define_layer(aTHX_ &PerlIO_unix);
-#ifdef WIN32
+#if defined(WIN32) && !defined(UNDER_CE)
    PerlIO_define_layer(aTHX_ &PerlIO_win32);
 #if 0
    osLayer = &PerlIO_win32;
@@ -954,8 +954,7 @@ PerlIO_binmode(pTHX_ PerlIO *f, int iotype, int mode, const char *names)
  if (!names && (O_TEXT != O_BINARY && (mode & O_BINARY)))
   {
    PerlIO *top = f;
-   PerlIOl *l;
-   while ((l = *top))
+   while (*top)
     {
      if (PerlIOBase(top)->tab == &PerlIO_crlf)
       {
@@ -1776,11 +1775,12 @@ SSize_t
 PerlIOBase_unread(PerlIO *f, const void *vbuf, Size_t count)
 {
  dTHX;
+ /* Save the position as current head considers it */
  Off_t old = PerlIO_tell(f);
  SSize_t done;
  PerlIO_push(aTHX_ f,&PerlIO_pending,"r",Nullsv);
+ PerlIOSelf(f,PerlIOBuf)->posn = old;
  done = PerlIOBuf_unread(f,vbuf,count);
- PerlIOSelf(f,PerlIOBuf)->posn = old - done;
  return done;
 }
 
@@ -2799,29 +2799,31 @@ PerlIOBuf_unread(PerlIO *f, const void *vbuf, Size_t count)
   {
    if (PerlIOBase(f)->flags & PERLIO_F_RDBUF)
     {
+     /* Buffer is already a read buffer, we can overwrite any chars
+        which have been read back to buffer start
+      */
      avail = (b->ptr - b->buf);
-     if (avail > (SSize_t) count)
-      avail = count;
     }
    else
     {
-     avail = b->bufsiz;
-     /* Adjust this here to keep a subsequent tell() correct.
-      * (b->ptr - b->buf) *MUST* be an accurate reflection of the amount
-      * unread in this buffer. (See previous part of the if for an example,
-      * or try PERLIO=unix on t/io/tell.t.)
-      */
-     if (avail > (SSize_t) count)
-      avail = count;
+     /* Buffer is idle, set it up so whole buffer is available for unread */
+     avail  = b->bufsiz;
      b->end = b->buf + avail;
      b->ptr = b->end;
      PerlIOBase(f)->flags |= PERLIO_F_RDBUF;
-     b->posn -= avail;
+     /* Buffer extends _back_ from where we are now */
+     b->posn -= b->bufsiz;
+    }
+   if (avail > (SSize_t) count)
+    {
+     /* If we have space for more than count, just move count */
+     avail = count;
     }
    if (avail > 0)
     {
      b->ptr -= avail;
      buf    -= avail;
+     /* In simple stdio-like ungetc() case chars will be already there */
      if (buf != b->ptr)
       {
        Copy(buf,b->ptr,avail,STDCHAR);
@@ -2906,9 +2908,13 @@ Off_t
 PerlIOBuf_tell(PerlIO *f)
 {
  PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
+ /* b->posn is file position where b->buf was read, or will be written */
  Off_t posn = b->posn;
  if (b->buf)
-  posn += (b->ptr - b->buf);
+  {
+   /* If buffer is valid adjust position by amount in buffer */
+   posn += (b->ptr - b->buf);
+  }
  return posn;
 }