grok_* symbols missing in Devel::PPPort (2nd attempt)

[p5sagit/p5-mst-13.2.git] / perlio.c

diff --git a/perlio.c b/perlio.c
index 38db370..a508b64 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;
@@ -2033,8 +2033,11 @@ PerlIOBase_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 {
     STDCHAR *buf = (STDCHAR *) vbuf;
     if (f) {
-       if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD))
+        if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD)) {
+           PerlIOBase(f)->flags |= PERLIO_F_ERROR;
+           SETERRNO(EBADF, SS_IVCHAN);
            return 0;
+       }
        while (count > 0) {
            SSize_t avail = PerlIO_get_cnt(f);
            SSize_t take = 0;
@@ -2977,6 +2980,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();
@@ -3405,9 +3410,12 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 {
     if (PerlIOValid(f)) {
        PerlIO *next = PerlIONext(f);
-       PerlIO_funcs *tab =  PerlIO_layer_fetch(aTHX_ layers, n - 1, PerlIOBase(next)->tab);
-       next = (*tab->Open) (aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
-                         next, narg, args);
+       PerlIO_funcs *tab =
+            PerlIO_layer_fetch(aTHX_ layers, n - 1, PerlIOBase(next)->tab);
+       if (tab && tab->Open)
+            next =
+                 (*tab->Open)(aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
+                              next, narg, args);
        if (!next || (*PerlIOBase(f)->tab->Pushed) (aTHX_ f, mode, PerlIOArg, self) != 0) {
            return NULL;
        }
@@ -3421,10 +3429,11 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
             * mode++;
             */
        }
-       f = tab && tab->Open ?
-         (*tab->Open) (aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
-                       f, narg, args)
-         : Nullfp;
+       if (tab && tab->Open)
+            f = (*tab->Open)(aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
+                             f, narg, args);
+       else
+            SETERRNO(EINVAL, LIB_INVARG);
        if (f) {
            if (PerlIO_push(aTHX_ f, self, mode, PerlIOArg) == 0) {
                /*
@@ -3453,8 +3462,6 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 #endif
            }
        }
-       else
-           SETERRNO(EINVAL, SS_IVCHAN);
     }
     return f;
 }
@@ -4031,6 +4038,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;
 }