Don't cast PL_multiline to bool : you may loose important bits.

[perl5.git] / perlio.c

diff --git a/perlio.c b/perlio.c
index 24293c0..7ee1eda 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -1070,7 +1070,7 @@ PerlIO_default_layers(pTHX)
        PerlIO_funcs *osLayer = &PerlIO_unix;
        PL_def_layerlist = PerlIO_list_alloc(aTHX);
        PerlIO_define_layer(aTHX_ & PerlIO_unix);
-#if defined(WIN32) && !defined(UNDER_CE)
+#if defined(WIN32)
        PerlIO_define_layer(aTHX_ & PerlIO_win32);
 #if 0
        osLayer = &PerlIO_win32;
@@ -2485,7 +2485,7 @@ PerlIOUnix_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
     }
 }
 
-Off_t
+IV
 PerlIOUnix_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
 {
     int fd = PerlIOSelf(f, PerlIOUnix)->fd;
@@ -2609,7 +2609,7 @@ PerlIOStdio_mode(const char *mode, char *tmode)
     while (*mode) {
        *tmode++ = *mode++;
     }
-#ifdef PERLIO_USING_CRLF
+#if defined(PERLIO_USING_CRLF) || defined(__CYGWIN__)
     *tmode++ = 'b';
 #endif
     *tmode = '\0';
@@ -2710,25 +2710,28 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
                fd = PerlLIO_open3(path, imode, perm);
            }
            else {
-               FILE *stdio = PerlSIO_fopen(path, mode);
-               if (stdio) {
-                   PerlIOStdio *s;
-                   if (!f) {
-                       f = PerlIO_allocate(aTHX);
-                   }
-                   if ((f = PerlIO_push(aTHX_ f, self,
-                                   (mode = PerlIOStdio_mode(mode, tmode)),
-                                   PerlIOArg))) {
-                       s = PerlIOSelf(f, PerlIOStdio);
-                       s->stdio = stdio;
-                       PerlIOUnix_refcnt_inc(fileno(s->stdio));
-                   }
-                   return f;
-               }
-               else {
-                   return NULL;
-               }
+                /* Append the 'b' - more correct for CRLF platforms
+                 * and Cygwin and should be harmless (since it's a
+                 * no-op) elsewhere. */
+                mode = PerlIOStdio_mode(mode, tmode);
+                {
+                     FILE *stdio = PerlSIO_fopen(path, mode);
+                     if (stdio) {
+                          PerlIOStdio *s;
+                          if (!f) {
+                               f = PerlIO_allocate(aTHX);
+                          }
+                          if ((f = PerlIO_push(aTHX_ f, self,
+                                               mode, PerlIOArg))) {
+                               s = PerlIOSelf(f, PerlIOStdio);
+                               s->stdio = stdio;
+                               PerlIOUnix_refcnt_inc(fileno(s->stdio));
+                         }
+                         return f;
+                     }
+                }
            }
+           return NULL;
        }
        if (fd >= 0) {
            FILE *stdio = NULL;
@@ -2980,6 +2983,8 @@ PerlIOStdio_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
        }
        else
            got = PerlSIO_fread(vbuf, 1, count, s);
+       if (got == 0 && PerlSIO_ferror(s))
+           got = -1;
        if (got >= 0 || errno != EINTR)
            break;
        PERL_ASYNC_CHECK();
@@ -3061,18 +3066,18 @@ PerlIOStdio_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
     return got;
 }
 
-Off_t
+IV
 PerlIOStdio_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
 {
     FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
-    return fseek(stdio, offset, whence);
+    return PerlSIO_fseek(stdio, offset, whence);
 }
 
 Off_t
 PerlIOStdio_tell(pTHX_ PerlIO *f)
 {
     FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
-    return ftell(stdio);
+    return PerlSIO_ftell(stdio);
 }
 
 IV
@@ -3713,7 +3718,7 @@ PerlIOBuf_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
     return written;
 }
 
-Off_t
+IV
 PerlIOBuf_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
 {
     IV code;
@@ -3912,7 +3917,7 @@ PerlIOPending_close(pTHX_ PerlIO *f)
     return PerlIO_close(f);
 }
 
-Off_t
+IV
 PerlIOPending_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
 {
     /*
@@ -4036,6 +4041,23 @@ PerlIOCrlf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
                 f, PerlIOBase(f)->tab->name, (mode) ? mode : "(Null)",
                 PerlIOBase(f)->flags);
 #endif
+    {
+      /* Enable the first CRLF capable layer you can find, but if none
+       * found, the one we just pushed is fine.  This results in at
+       * any given moment at most one CRLF-capable layer being enabled
+       * in the whole layer stack. */
+        PerlIO *g = PerlIONext(f);
+        while (g && *g) {
+             PerlIOl *b = PerlIOBase(g);
+             if (b && b->tab == &PerlIO_crlf) {
+                  if (!(b->flags & PERLIO_F_CRLF))
+                       b->flags |= PERLIO_F_CRLF;
+                  PerlIO_pop(aTHX_ f);
+                  return code;
+             }           
+             g = PerlIONext(g);
+        }
+    }
     return code;
 }