X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perlio.c;h=6b6e6e47822591f32533f4afe31a6ad5a55635cf;hb=5eb9fe8fe9c9104d4fe0d9127fe7389780f8a479;hp=edfdf17a5eadc08a01b905ca1f7b04f32e34be10;hpb=a33cf58c90e96ed3c4b1c1fdbaf666d924440940;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perlio.c b/perlio.c
index edfdf17..6b6e6e4 100644
--- a/perlio.c
+++ b/perlio.c
@@ -990,17 +990,35 @@ PerlIO_stdstreams(pTHX)
 PerlIO *
 PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab, const char *mode, SV *arg)
 {
-    PerlIOl *l = NULL;
-    Newc('L',l,tab->size,char,PerlIOl);
-    if (l && f) {
-	Zero(l, tab->size, char);
-	l->next = *f;
-	l->tab = tab;
-	*f = l;
+    if (tab->fsize != sizeof(PerlIO_funcs)) {
+      mismatch:
+	Perl_croak(aTHX_ "Layer does not match this perl");
+    }
+    if (tab->size) {
+	PerlIOl *l = NULL;
+	if (tab->size < sizeof(PerlIOl)) {
+	    goto mismatch;
+	}
+	/* Real layer with a data area */
+	Newc('L',l,tab->size,char,PerlIOl);
+	if (l && f) {
+	    Zero(l, tab->size, char);
+	    l->next = *f;
+	    l->tab = tab;
+	    *f = l;
+	    PerlIO_debug("PerlIO_push f=%p %s %s %p\n", (void*)f, tab->name,
+			(mode) ? mode : "(Null)", (void*)arg);
+	    if ((*l->tab->Pushed) (aTHX_ f, mode, arg, tab) != 0) {
+		PerlIO_pop(aTHX_ f);
+		return NULL;
+	    }
+	}
+    }
+    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 ((*l->tab->Pushed) (aTHX_ f, mode, arg) != 0) {
-	    PerlIO_pop(aTHX_ f);
+	if ((*tab->Pushed) (aTHX_ f, mode, arg, tab) != 0) {
 	    return NULL;
 	}
     }
@@ -1008,7 +1026,7 @@ PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab, const char *mode, SV *arg)
 }
 
 IV
-PerlIOPop_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
+PerlIOPop_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 {
     PerlIO_pop(aTHX_ f);
     if (*f) {
@@ -1038,13 +1056,12 @@ PerlIOBase_binmode(pTHX_ PerlIO *f)
 }
 
 IV
-PerlIORaw_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
+PerlIORaw_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 {
 
     if (PerlIOValid(f)) {
 	PerlIO *t;
 	PerlIOl *l;
-	PerlIO_pop(aTHX_ f);     /* Remove the dummy layer */
 	PerlIO_flush(f);
 	/*
 	 * Strip all layers that are not suitable for a raw stream
@@ -1238,7 +1255,7 @@ PerlIO_layer_from_ref(pTHX_ SV *sv)
      * For any scalar type load the handler which is bundled with perl
      */
     if (SvTYPE(sv) < SVt_PVAV)
-	return PerlIO_find_layer(aTHX_ "Scalar", 6, 1);
+	return PerlIO_find_layer(aTHX_ "scalar", 6, 1);
 
     /*
      * For other types allow if layer is known but don't try and load it
@@ -1278,7 +1295,7 @@ PerlIO_resolve_layers(pTHX_ const char *layers,
 		incdef = 0;
 	    }
 	    /*
-	     * Don't fail if handler cannot be found :Via(...) etc. may do
+	     * Don't fail if handler cannot be found :via(...) etc. may do
 	     * something sensible else we will just stringfy and open
 	     * resulting string.
 	     */
@@ -1680,11 +1697,9 @@ Perl_PerlIO_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, int cnt)
  */
 
 IV
-PerlIOUtf8_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
+PerlIOUtf8_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 {
-    if (*PerlIONext(f)) {
-	PerlIO_funcs *tab = PerlIOBase(f)->tab;
-	PerlIO_pop(aTHX_ f);
+    if (PerlIOValid(f)) {
 	if (tab->kind & PERLIO_K_UTF8)
 	    PerlIOBase(f)->flags |= PERLIO_F_UTF8;
 	else
@@ -1695,8 +1710,9 @@ PerlIOUtf8_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
 }
 
 PerlIO_funcs PerlIO_utf8 = {
+    sizeof(PerlIO_funcs),
     "utf8",
-    sizeof(PerlIOl),
+    0,
     PERLIO_K_DUMMY | PERLIO_K_UTF8,
     PerlIOUtf8_pushed,
     NULL,
@@ -1723,8 +1739,9 @@ PerlIO_funcs PerlIO_utf8 = {
 };
 
 PerlIO_funcs PerlIO_byte = {
+    sizeof(PerlIO_funcs),
     "bytes",
-    sizeof(PerlIOl),
+    0,
     PERLIO_K_DUMMY,
     PerlIOUtf8_pushed,
     NULL,
@@ -1761,8 +1778,9 @@ PerlIORaw_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 }
 
 PerlIO_funcs PerlIO_raw = {
+    sizeof(PerlIO_funcs),
     "raw",
-    sizeof(PerlIOl),
+    0,
     PERLIO_K_DUMMY,
     PerlIORaw_pushed,
     PerlIOBase_popped,
@@ -1830,14 +1848,13 @@ PerlIO_modestr(PerlIO *f, char *buf)
 }
 
 IV
-PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
+PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 {
     PerlIOl *l = PerlIOBase(f);
 #if 0
     const char *omode = mode;
     char temp[8];
 #endif
-    PerlIO_funcs *tab = PerlIOBase(f)->tab;
     l->flags &= ~(PERLIO_F_CANREAD | PERLIO_F_CANWRITE |
 		  PERLIO_F_TRUNCATE | PERLIO_F_APPEND);
     if (tab->Set_ptrcnt != NULL)
@@ -2195,9 +2212,9 @@ PerlIOUnix_fileno(pTHX_ PerlIO *f)
 }
 
 IV
-PerlIOUnix_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
+PerlIOUnix_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 {
-    IV code = PerlIOBase_pushed(aTHX_ f, mode, arg);
+    IV code = PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
     PerlIOUnix *s = PerlIOSelf(f, PerlIOUnix);
     if (*PerlIONext(f)) {
 	/* We never call down so do any pending stuff now */
@@ -2290,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) {
@@ -2365,6 +2384,7 @@ PerlIOUnix_close(pTHX_ PerlIO *f)
 }
 
 PerlIO_funcs PerlIO_unix = {
+    sizeof(PerlIO_funcs),
     "unix",
     sizeof(PerlIOUnix),
     PERLIO_K_RAW,
@@ -2415,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 *
@@ -2432,27 +2457,32 @@ 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)
+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);
+    return PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
 }
 
 
@@ -2534,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) {
@@ -2613,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);
@@ -2923,10 +2960,11 @@ PerlIOStdio_fill(pTHX_ PerlIO *f)
 
 
 PerlIO_funcs PerlIO_stdio = {
+    sizeof(PerlIO_funcs),
     "stdio",
     sizeof(PerlIOStdio),
     PERLIO_K_BUFFERED|PERLIO_K_RAW,
-    PerlIOBase_pushed,
+    PerlIOStdio_pushed,
     PerlIOBase_popped,
     PerlIOStdio_open,
     PerlIOBase_binmode,         /* binmode */
@@ -3026,7 +3064,7 @@ PerlIO_releaseFILE(PerlIO *p, FILE *f)
  */
 
 IV
-PerlIOBuf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
+PerlIOBuf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 {
     PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
     int fd = PerlIO_fileno(f);
@@ -3039,7 +3077,7 @@ PerlIOBuf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
 	    b->posn = posn;
 	}
     }
-    return PerlIOBase_pushed(aTHX_ f, mode, arg);
+    return PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
 }
 
 PerlIO *
@@ -3052,7 +3090,7 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 	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);
-	if (!next || (*PerlIOBase(f)->tab->Pushed) (aTHX_ f, mode, PerlIOArg) != 0) {
+	if (!next || (*PerlIOBase(f)->tab->Pushed) (aTHX_ f, mode, PerlIOArg, self) != 0) {
 	    return NULL;
 	}
     }
@@ -3474,6 +3512,7 @@ PerlIOBuf_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
 
 
 PerlIO_funcs PerlIO_perlio = {
+    sizeof(PerlIO_funcs),
     "perlio",
     sizeof(PerlIOBuf),
     PERLIO_K_BUFFERED|PERLIO_K_RAW,
@@ -3563,9 +3602,9 @@ PerlIOPending_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt)
 }
 
 IV
-PerlIOPending_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
+PerlIOPending_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 {
-    IV code = PerlIOBase_pushed(aTHX_ f, mode, arg);
+    IV code = PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
     PerlIOl *l = PerlIOBase(f);
     /*
      * Our PerlIO_fast_gets must match what we are pushed on, or sv_gets()
@@ -3596,6 +3635,7 @@ PerlIOPending_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 }
 
 PerlIO_funcs PerlIO_pending = {
+    sizeof(PerlIO_funcs),
     "pending",
     sizeof(PerlIOBuf),
     PERLIO_K_BUFFERED|PERLIO_K_RAW,  /* not sure about RAW here */
@@ -3641,11 +3681,11 @@ typedef struct {
 } PerlIOCrlf;
 
 IV
-PerlIOCrlf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
+PerlIOCrlf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 {
     IV code;
     PerlIOBase(f)->flags |= PERLIO_F_CRLF;
-    code = PerlIOBuf_pushed(aTHX_ f, mode, arg);
+    code = PerlIOBuf_pushed(aTHX_ f, mode, arg, tab);
 #if 0
     PerlIO_debug("PerlIOCrlf_pushed f=%p %s %s fl=%08" UVxf "\n",
 		 f, PerlIOBase(f)->tab->name, (mode) ? mode : "(Null)",
@@ -3906,6 +3946,7 @@ PerlIOCrlf_binmode(pTHX_ PerlIO *f)
 }
 
 PerlIO_funcs PerlIO_crlf = {
+    sizeof(PerlIO_funcs),
     "crlf",
     sizeof(PerlIOCrlf),
     PERLIO_K_BUFFERED | PERLIO_K_CANCRLF | PERLIO_K_RAW,
@@ -4222,6 +4263,7 @@ PerlIOMmap_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
 
 
 PerlIO_funcs PerlIO_mmap = {
+    sizeof(PerlIO_funcs),
     "mmap",
     sizeof(PerlIOMmap),
     PERLIO_K_BUFFERED|PERLIO_K_RAW,
@@ -4596,3 +4638,6 @@ PerlIO_sprintf(char *s, int n, const char *fmt, ...)
 
 
 
+
+
+