Fix open(FH,"Via(Foo)","NonExistant") and other cases when

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

diff --git a/perlio.c b/perlio.c
index f8d6517..3cce842 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -1016,6 +1016,8 @@ PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab, const char *mode, SV *arg)
     }
     else if (f) {
        /* Pseudo-layer where push does its own stack adjust */
+       PerlIO_debug("PerlIO_push f=%p %s %s %p\n", (void*)f, tab->name,
+                    (mode) ? mode : "(Null)", (void*)arg);
        if ((*tab->Pushed) (aTHX_ f, mode, arg, tab) != 0) {
            return NULL;
        }
@@ -1697,7 +1699,7 @@ Perl_PerlIO_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, int cnt)
 IV
 PerlIOUtf8_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 {
-    if (*PerlIONext(f)) {
+    if (PerlIOValid(f)) {
        if (tab->kind & PERLIO_K_UTF8)
            PerlIOBase(f)->flags |= PERLIO_F_UTF8;
        else
@@ -2305,8 +2307,10 @@ SSize_t
 PerlIOUnix_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 {
     int fd = PerlIOSelf(f, PerlIOUnix)->fd;
-    if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD))
+    if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD) || 
+         PerlIOBase(f)->flags & (PERLIO_F_EOF|PERLIO_F_ERROR)) {
        return 0;
+    }
     while (1) {
        SSize_t len = PerlLIO_read(fd, vbuf, count);
        if (len >= 0 || errno != EINTR) {
@@ -2431,7 +2435,12 @@ typedef struct {
 IV
 PerlIOStdio_fileno(pTHX_ PerlIO *f)
 {
-    return PerlSIO_fileno(PerlIOSelf(f, PerlIOStdio)->stdio);
+    FILE *s;
+    if (PerlIOValid(f) && (s = PerlIOSelf(f, PerlIOStdio)->stdio)) {    
+       return PerlSIO_fileno(s);
+    }
+    errno = EBADF;
+    return -1;
 }
 
 char *
@@ -2448,25 +2457,30 @@ PerlIOStdio_mode(const char *mode, char *tmode)
     return ret;
 }
 
-/*
- * This isn't used yet ...
- */
 IV
 PerlIOStdio_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 {
-    if (*PerlIONext(f)) {
-       PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio);
-       char tmode[8];
-       FILE *stdio =
-           PerlSIO_fdopen(PerlIO_fileno(PerlIONext(f)), mode =
-                          PerlIOStdio_mode(mode, tmode));
-       if (stdio) {
-           s->stdio = stdio;
-           /* We never call down so do any pending stuff now */
-           PerlIO_flush(PerlIONext(f));
-       }
-       else
-           return -1;
+    PerlIO *n;
+    if (PerlIOValid(f) && PerlIOValid(n = PerlIONext(f))) {
+        PerlIO_funcs *toptab = PerlIOBase(n)->tab;
+        if (toptab == tab) {
+           /* Top is already stdio - pop self (duplicate) and use original */
+           PerlIO_pop(aTHX_ f);
+           return 0;
+       } else {
+           int fd = PerlIO_fileno(n);
+           char tmode[8];
+           FILE *stdio;
+           if (fd >= 0 && (stdio  = PerlSIO_fdopen(fd, 
+                           mode = PerlIOStdio_mode(mode, tmode)))) {
+               PerlIOSelf(f, PerlIOStdio)->stdio = stdio;
+               /* We never call down so do any pending stuff now */
+               PerlIO_flush(PerlIONext(f));
+           } 
+           else {
+               return -1;
+           }
+        }
     }
     return PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
 }
@@ -2550,8 +2564,11 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
                        s->stdio = stdio;
                        PerlIOUnix_refcnt_inc(fileno(s->stdio));
                    }
+                   return f;
+               }
+               else {
+                   return NULL;
                }
-               return f;
            }
        }
        if (fd >= 0) {
@@ -2629,6 +2646,10 @@ PerlIOStdio_close(pTHX_ PerlIO *f)
     Sock_size_t optlen = sizeof(int);
 #endif
     FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
+    if (!stdio) {
+       errno = EBADF;
+       return -1;
+    }
     if (PerlIOUnix_refcnt_dec(fileno(stdio)) > 0) {
        /* Do not close it but do flush any buffers */
        return PerlIO_flush(f);
@@ -2943,7 +2964,7 @@ PerlIO_funcs PerlIO_stdio = {
     "stdio",
     sizeof(PerlIOStdio),
     PERLIO_K_BUFFERED|PERLIO_K_RAW,
-    PerlIOBase_pushed,
+    PerlIOStdio_pushed,
     PerlIOBase_popped,
     PerlIOStdio_open,
     PerlIOBase_binmode,         /* binmode */
@@ -4617,3 +4638,6 @@ PerlIO_sprintf(char *s, int n, const char *fmt, ...)
 
 
 
+
+
+