X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perlio.c;h=60346b516c3d53002bfdd764f8581537531f103f;hb=8a6aa900aaa729fd6735df2eb96e87e52d2662e8;hp=173907e3191e2813cf77897bc510491951b2e140;hpb=e87a358ade5a3dd9a8b192569e18211d76c93743;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perlio.c b/perlio.c
index 173907e..60346b5 100644
--- a/perlio.c
+++ b/perlio.c
@@ -1,10 +1,15 @@
 /*
- * perlio.c Copyright (c) 1996-2001, Nick Ing-Simmons You may distribute
+ * perlio.c Copyright (c) 1996-2002, Nick Ing-Simmons You may distribute
  * under the terms of either the GNU General Public License or the
  * Artistic License, as specified in the README file.
  */
 
 /*
+ * Hour after hour for nearly three weary days he had jogged up and down,
+ * over passes, and through long dales, and across many streams.
+ */
+
+/*
  * If we have ActivePerl-like PERL_IMPLICIT_SYS then we need a dTHX to get
  * at the dispatch tables, even when we do not need it for other reasons.
  * Invent a dSYS macro to abstract this out
@@ -89,6 +94,7 @@ perlsio_binmode(FILE *fp, int iotype, int mode)
 #  endif
 #else
 #  if defined(USEMYBINMODE)
+    dTHX;
     if (my_binmode(fp, iotype, mode) != FALSE)
 	return 1;
     else
@@ -186,6 +192,9 @@ PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
 	if (fd >= 0) {
 	    char mode[8];
 	    int omode = fcntl(fd, F_GETFL);
+#ifdef DJGPP
+	    omode = djgpp_get_stream_mode(f);
+#endif
 	    PerlIO_intmode2str(omode,mode,NULL);
 	    /* the r+ is a hack */
 	    return PerlIO_fdopen(fd, mode);
@@ -447,7 +456,7 @@ PerlIO_allocate(pTHX)
 PerlIO *
 PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
 {
-    if (f && *f) {
+    if (PerlIOValid(f)) {
 	PerlIO_funcs *tab = PerlIOBase(f)->tab;
 	PerlIO *new;
 	PerlIO_debug("fdupopen f=%p param=%p\n",(void*)f,(void*)param);
@@ -786,7 +795,8 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
 		     * seen as an invalid separator character.
 		     */
 		    char q = ((*s == '\'') ? '"' : '\'');
-		    Perl_warn(aTHX_
+		    if (ckWARN(WARN_LAYER))
+		        Perl_warner(aTHX_ packWARN(WARN_LAYER),
 			      "perlio: invalid separator character %c%c%c in layer specification list %s",
 			      q, *s, q, s);
 		    return -1;
@@ -821,7 +831,8 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
 			     */
 			case '\0':
 			    e--;
-			    Perl_warn(aTHX_
+		    	    if (ckWARN(WARN_LAYER))
+			        Perl_warner(aTHX_ packWARN(WARN_LAYER),
 				      "perlio: argument list not closed for layer \"%.*s\"",
 				      (int) (e - s), s);
 			    return -1;
@@ -834,6 +845,7 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
 		    }
 		}
 		if (e > s) {
+		    bool warn_layer = ckWARN(WARN_LAYER);
 		    PerlIO_funcs *layer =
 			PerlIO_find_layer(aTHX_ s, llen, 1);
 		    if (layer) {
@@ -843,7 +855,8 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
 					 &PL_sv_undef);
 		    }
 		    else {
-			Perl_warn(aTHX_ "perlio: unknown layer \"%.*s\"",
+		    	if (warn_layer)
+			    Perl_warner(aTHX_ packWARN(WARN_LAYER), "perlio: unknown layer \"%.*s\"",
 				  (int) llen, s);
 			return -1;
 		    }
@@ -1003,7 +1016,7 @@ PerlIORaw_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
     /*
      * Pop back to bottom layer
      */
-    if (f && *f) {
+    if (PerlIOValid(f)) {
 	PerlIO_flush(f);
 	while (!(PerlIOBase(f)->tab->kind & PERLIO_K_RAW)) {
 	    if (*PerlIONext(f)) {
@@ -1071,30 +1084,79 @@ PerlIO_binmode(pTHX_ PerlIO *f, int iotype, int mode, const char *names)
     PerlIO_debug("PerlIO_binmode f=%p %s %c %x %s\n",
 		 (void*)f, PerlIOBase(f)->tab->name, iotype, mode,
 		 (names) ? names : "(Null)");
-    /* Can't flush if switching encodings. */
-    if (!(names && memEQ(names, ":encoding(", 10))) {
-        PerlIO_flush(f);
+    if (names) {
+	/* Do not flush etc. if (e.g.) switching encodings.
+	   if a pushed layer knows it needs to flush lower layers
+	   (for example :unix which is never going to call them)
+	   it can do the flush when it is pushed.
+	 */
+	return PerlIO_apply_layers(aTHX_ f, NULL, names) == 0 ? TRUE : FALSE;
+    }
+    else {
+	/* FIXME?: Looking down the layer stack seems wrong,
+	   but is a way of reaching past (say) an encoding layer
+	   to flip CRLF-ness of the layer(s) below
+	 */
 #ifdef PERLIO_USING_CRLF
-	if (!names && (mode & O_BINARY)) {
-	    PerlIO *top = f;
-	    while (*top) {
-	        if (PerlIOBase(top)->tab == &PerlIO_crlf) {
-		  PerlIOBase(top)->flags &= ~PERLIO_F_CRLF;
-		  break;
+	/* Legacy binmode only has meaning if O_TEXT has a value distinct from
+	   O_BINARY so we can look for it in mode.
+	 */
+	if (!(mode & O_BINARY)) {
+	    /* Text mode */
+	    while (*f) {
+		/* Perhaps we should turn on bottom-most aware layer
+		   e.g. Ilya's idea that UNIX TTY could serve
+		 */
+		if (PerlIOBase(f)->tab->kind & PERLIO_K_CANCRLF) {
+		    if (!(PerlIOBase(f)->flags & PERLIO_F_CRLF)) {
+			/* Not in text mode - flush any pending stuff and flip it */
+			PerlIO_flush(f);
+			PerlIOBase(f)->flags |= PERLIO_F_CRLF;
+		    }
+		    /* Only need to turn it on in one layer so we are done */
+		    return TRUE;
 		}
-		top = PerlIONext(top);
-		PerlIO_flush(top);
+		f = PerlIONext(f);
 	    }
+	    /* Not finding a CRLF aware layer presumably means we are binary
+	       which is not what was requested - so we failed
+	       We _could_ push :crlf layer but so could caller
+	     */
+	    return FALSE;
 	}
 #endif
+	/* Either asked for BINMODE or that is normal on this platform
+	   see if any CRLF aware layers are present and turn off the flag
+	   and possibly remove layer.
+	 */
+	while (*f) {
+	    if (PerlIOBase(f)->tab->kind & PERLIO_K_CANCRLF) {
+		if ((PerlIOBase(f)->flags & PERLIO_F_CRLF)) {
+		    /* In text mode - flush any pending stuff and flip it */
+		    PerlIO_flush(f);
+		    PerlIOBase(f)->flags &= ~PERLIO_F_CRLF;
+#ifndef PERLIO_USING_CRLF
+		    /* CRLF is unusual case - if this is just the :crlf layer pop it */
+		    if (PerlIOBase(f)->tab == &PerlIO_crlf) {
+			PerlIO_pop(aTHX_ f);
+		    }
+#endif
+		    /* Normal case is only one layer doing this, so exit on first
+		       abnormal case can always do multiple binmode calls
+		     */
+		    return TRUE;
+		}
+	    }
+	    f = PerlIONext(f);
+	}
+	return TRUE;
     }
-    return PerlIO_apply_layers(aTHX_ f, NULL, names) == 0 ? TRUE : FALSE;
 }
 
 int
 PerlIO__close(pTHX_ PerlIO *f)
 {
-    if (f && *f)
+    if (PerlIOValid(f))
 	return (*PerlIOBase(f)->tab->Close) (aTHX_ f);
     else {
 	SETERRNO(EBADF, SS$_IVCHAN);
@@ -1106,7 +1168,7 @@ int
 Perl_PerlIO_close(pTHX_ PerlIO *f)
 {
     int code = -1;
-    if (f && *f) {
+    if (PerlIOValid(f)) {
 	code = (*PerlIOBase(f)->tab->Close) (aTHX_ f);
 	while (*f) {
 	    PerlIO_pop(aTHX_ f);
@@ -1118,7 +1180,7 @@ Perl_PerlIO_close(pTHX_ PerlIO *f)
 int
 Perl_PerlIO_fileno(pTHX_ PerlIO *f)
 {
-    if (f && *f)
+    if (PerlIOValid(f))
 	return (*PerlIOBase(f)->tab->Fileno) (aTHX_ f);
     else {
 	SETERRNO(EBADF, SS$_IVCHAN);
@@ -1246,7 +1308,7 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
 	PerlIO_list_t *layera = NULL;
 	IV n;
 	PerlIO_funcs *tab = NULL;
-	if (f && *f) {
+	if (PerlIOValid(f)) {
 	    /*
 	     * This is "reopen" - it is not tested as perl does not use it
 	     * yet
@@ -1254,9 +1316,9 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
 	    PerlIOl *l = *f;
 	    layera = PerlIO_list_alloc(aTHX);
 	    while (l) {
-		SV *arg =
-		    (l->tab->Getarg) ? (*l->tab->
-					Getarg) (aTHX_ &l, NULL, 0) : &PL_sv_undef;
+		SV *arg = (l->tab->Getarg)
+			? (*l->tab->Getarg) (aTHX_ &l, NULL, 0)
+			: &PL_sv_undef;
 		PerlIO_list_push(aTHX_ layera, l->tab, arg);
 		l = *PerlIONext(&l);
 	    }
@@ -1310,7 +1372,7 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
 SSize_t
 Perl_PerlIO_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 {
-    if (f && *f)
+    if (PerlIOValid(f))
 	return (*PerlIOBase(f)->tab->Read) (aTHX_ f, vbuf, count);
     else {
 	SETERRNO(EBADF, SS$_IVCHAN);
@@ -1321,7 +1383,7 @@ Perl_PerlIO_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 SSize_t
 Perl_PerlIO_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
-    if (f && *f)
+    if (PerlIOValid(f))
 	return (*PerlIOBase(f)->tab->Unread) (aTHX_ f, vbuf, count);
     else {
 	SETERRNO(EBADF, SS$_IVCHAN);
@@ -1332,7 +1394,7 @@ Perl_PerlIO_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 SSize_t
 Perl_PerlIO_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
-    if (f && *f)
+    if (PerlIOValid(f))
 	return (*PerlIOBase(f)->tab->Write) (aTHX_ f, vbuf, count);
     else {
 	SETERRNO(EBADF, SS$_IVCHAN);
@@ -1343,7 +1405,7 @@ Perl_PerlIO_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 int
 Perl_PerlIO_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
 {
-    if (f && *f)
+    if (PerlIOValid(f))
 	return (*PerlIOBase(f)->tab->Seek) (aTHX_ f, offset, whence);
     else {
 	SETERRNO(EBADF, SS$_IVCHAN);
@@ -1354,7 +1416,7 @@ Perl_PerlIO_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
 Off_t
 Perl_PerlIO_tell(pTHX_ PerlIO *f)
 {
-    if (f && *f)
+    if (PerlIOValid(f))
 	return (*PerlIOBase(f)->tab->Tell) (aTHX_ f);
     else {
 	SETERRNO(EBADF, SS$_IVCHAN);
@@ -1428,7 +1490,7 @@ PerlIOBase_flush_linebuf(pTHX)
 int
 Perl_PerlIO_fill(pTHX_ PerlIO *f)
 {
-    if (f && *f)
+    if (PerlIOValid(f))
 	return (*PerlIOBase(f)->tab->Fill) (aTHX_ f);
     else {
 	SETERRNO(EBADF, SS$_IVCHAN);
@@ -1439,7 +1501,7 @@ Perl_PerlIO_fill(pTHX_ PerlIO *f)
 int
 PerlIO_isutf8(PerlIO *f)
 {
-    if (f && *f)
+    if (PerlIOValid(f))
 	return (PerlIOBase(f)->flags & PERLIO_F_UTF8) != 0;
     else {
 	SETERRNO(EBADF, SS$_IVCHAN);
@@ -1450,7 +1512,7 @@ PerlIO_isutf8(PerlIO *f)
 int
 Perl_PerlIO_eof(pTHX_ PerlIO *f)
 {
-    if (f && *f)
+    if (PerlIOValid(f))
 	return (*PerlIOBase(f)->tab->Eof) (aTHX_ f);
     else {
 	SETERRNO(EBADF, SS$_IVCHAN);
@@ -1461,7 +1523,7 @@ Perl_PerlIO_eof(pTHX_ PerlIO *f)
 int
 Perl_PerlIO_error(pTHX_ PerlIO *f)
 {
-    if (f && *f)
+    if (PerlIOValid(f))
 	return (*PerlIOBase(f)->tab->Error) (aTHX_ f);
     else {
 	SETERRNO(EBADF, SS$_IVCHAN);
@@ -1472,7 +1534,7 @@ Perl_PerlIO_error(pTHX_ PerlIO *f)
 void
 Perl_PerlIO_clearerr(pTHX_ PerlIO *f)
 {
-    if (f && *f)
+    if (PerlIOValid(f))
 	(*PerlIOBase(f)->tab->Clearerr) (aTHX_ f);
     else
 	SETERRNO(EBADF, SS$_IVCHAN);
@@ -1481,7 +1543,7 @@ Perl_PerlIO_clearerr(pTHX_ PerlIO *f)
 void
 Perl_PerlIO_setlinebuf(pTHX_ PerlIO *f)
 {
-    if (f && *f)
+    if (PerlIOValid(f))
 	(*PerlIOBase(f)->tab->Setlinebuf) (aTHX_ f);
     else
 	SETERRNO(EBADF, SS$_IVCHAN);
@@ -1490,7 +1552,7 @@ Perl_PerlIO_setlinebuf(pTHX_ PerlIO *f)
 int
 PerlIO_has_base(PerlIO *f)
 {
-    if (f && *f) {
+    if (PerlIOValid(f)) {
 	return (PerlIOBase(f)->tab->Get_base != NULL);
     }
     return 0;
@@ -1499,7 +1561,7 @@ PerlIO_has_base(PerlIO *f)
 int
 PerlIO_fast_gets(PerlIO *f)
 {
-    if (f && *f && (PerlIOBase(f)->flags & PERLIO_F_FASTGETS)) {
+    if (PerlIOValid(f) && (PerlIOBase(f)->flags & PERLIO_F_FASTGETS)) {
 	PerlIO_funcs *tab = PerlIOBase(f)->tab;
 	return (tab->Set_ptrcnt != NULL);
     }
@@ -1509,7 +1571,7 @@ PerlIO_fast_gets(PerlIO *f)
 int
 PerlIO_has_cntptr(PerlIO *f)
 {
-    if (f && *f) {
+    if (PerlIOValid(f)) {
 	PerlIO_funcs *tab = PerlIOBase(f)->tab;
 	return (tab->Get_ptr != NULL && tab->Get_cnt != NULL);
     }
@@ -1519,7 +1581,7 @@ PerlIO_has_cntptr(PerlIO *f)
 int
 PerlIO_canset_cnt(PerlIO *f)
 {
-    if (f && *f) {
+    if (PerlIOValid(f)) {
 	PerlIOl *l = PerlIOBase(f);
 	return (l->tab->Set_ptrcnt != NULL);
     }
@@ -1529,7 +1591,7 @@ PerlIO_canset_cnt(PerlIO *f)
 STDCHAR *
 Perl_PerlIO_get_base(pTHX_ PerlIO *f)
 {
-    if (f && *f)
+    if (PerlIOValid(f))
 	return (*PerlIOBase(f)->tab->Get_base) (aTHX_ f);
     return NULL;
 }
@@ -1537,7 +1599,7 @@ Perl_PerlIO_get_base(pTHX_ PerlIO *f)
 int
 Perl_PerlIO_get_bufsiz(pTHX_ PerlIO *f)
 {
-    if (f && *f)
+    if (PerlIOValid(f))
 	return (*PerlIOBase(f)->tab->Get_bufsiz) (aTHX_ f);
     return 0;
 }
@@ -1545,35 +1607,45 @@ Perl_PerlIO_get_bufsiz(pTHX_ PerlIO *f)
 STDCHAR *
 Perl_PerlIO_get_ptr(pTHX_ PerlIO *f)
 {
-    PerlIO_funcs *tab = PerlIOBase(f)->tab;
-    if (tab->Get_ptr == NULL)
-	return NULL;
-    return (*tab->Get_ptr) (aTHX_ f);
+    if (PerlIOValid(f)) {
+	PerlIO_funcs *tab = PerlIOBase(f)->tab;
+	if (tab->Get_ptr == NULL)
+	    return NULL;
+	return (*tab->Get_ptr) (aTHX_ f);
+    }
+    return NULL;
 }
 
 int
 Perl_PerlIO_get_cnt(pTHX_ PerlIO *f)
 {
-    PerlIO_funcs *tab = PerlIOBase(f)->tab;
-    if (tab->Get_cnt == NULL)
-	return 0;
-    return (*tab->Get_cnt) (aTHX_ f);
+    if (PerlIOValid(f)) {
+	PerlIO_funcs *tab = PerlIOBase(f)->tab;
+	if (tab->Get_cnt == NULL)
+	   return 0;
+	return (*tab->Get_cnt) (aTHX_ f);
+    }
+    return 0;
 }
 
 void
 Perl_PerlIO_set_cnt(pTHX_ PerlIO *f, int cnt)
 {
-    (*PerlIOBase(f)->tab->Set_ptrcnt) (aTHX_ f, NULL, cnt);
+    if (PerlIOValid(f)) {
+	(*PerlIOBase(f)->tab->Set_ptrcnt) (aTHX_ f, NULL, cnt);
+    }
 }
 
 void
 Perl_PerlIO_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, int cnt)
 {
-    PerlIO_funcs *tab = PerlIOBase(f)->tab;
-    if (tab->Set_ptrcnt == NULL) {
-	Perl_croak(aTHX_ "PerlIO buffer snooping abuse");
+    if (PerlIOValid(f)) {
+	PerlIO_funcs *tab = PerlIOBase(f)->tab;
+	if (tab->Set_ptrcnt == NULL) {
+	    Perl_croak(aTHX_ "PerlIO buffer snooping abuse");
+	}
+	(*PerlIOBase(f)->tab->Set_ptrcnt) (aTHX_ f, ptr, cnt);
     }
-    (*PerlIOBase(f)->tab->Set_ptrcnt) (aTHX_ f, ptr, cnt);
 }
 
 /*--------------------------------------------------------------------------------------*/
@@ -1584,7 +1656,7 @@ Perl_PerlIO_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, int cnt)
 IV
 PerlIOUtf8_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
 {
-    if (PerlIONext(f)) {
+    if (*PerlIONext(f)) {
 	PerlIO_funcs *tab = PerlIOBase(f)->tab;
 	PerlIO_pop(aTHX_ f);
 	if (tab->kind & PERLIO_K_UTF8)
@@ -1698,7 +1770,7 @@ PerlIO_funcs PerlIO_raw = {
 IV
 PerlIOBase_fileno(pTHX_ PerlIO *f)
 {
-    return PerlIO_fileno(PerlIONext(f));
+    return PerlIOValid(f) ? PerlIO_fileno(PerlIONext(f)) : -1;
 }
 
 char *
@@ -1861,7 +1933,7 @@ PerlIOBase_close(pTHX_ PerlIO *f)
     PerlIO *n = PerlIONext(f);
     if (PerlIO_flush(f) != 0)
 	code = -1;
-    if (n && *n && (*PerlIOBase(n)->tab->Close)(aTHX_ n) != 0)
+    if (PerlIOValid(n) && (*PerlIOBase(n)->tab->Close)(aTHX_ n) != 0)
 	code = -1;
     PerlIOBase(f)->flags &=
 	~(PERLIO_F_CANREAD | PERLIO_F_CANWRITE | PERLIO_F_OPEN);
@@ -1871,7 +1943,7 @@ PerlIOBase_close(pTHX_ PerlIO *f)
 IV
 PerlIOBase_eof(pTHX_ PerlIO *f)
 {
-    if (f && *f) {
+    if (PerlIOValid(f)) {
 	return (PerlIOBase(f)->flags & PERLIO_F_EOF) != 0;
     }
     return 1;
@@ -1880,7 +1952,7 @@ PerlIOBase_eof(pTHX_ PerlIO *f)
 IV
 PerlIOBase_error(pTHX_ PerlIO *f)
 {
-    if (f && *f) {
+    if (PerlIOValid(f)) {
 	return (PerlIOBase(f)->flags & PERLIO_F_ERROR) != 0;
     }
     return 1;
@@ -1889,10 +1961,10 @@ PerlIOBase_error(pTHX_ PerlIO *f)
 void
 PerlIOBase_clearerr(pTHX_ PerlIO *f)
 {
-    if (f && *f) {
+    if (PerlIOValid(f)) {
 	PerlIO *n = PerlIONext(f);
 	PerlIOBase(f)->flags &= ~(PERLIO_F_ERROR | PERLIO_F_EOF);
-	if (n)
+	if (PerlIOValid(n))
 	    PerlIO_clearerr(n);
     }
 }
@@ -1900,7 +1972,7 @@ PerlIOBase_clearerr(pTHX_ PerlIO *f)
 void
 PerlIOBase_setlinebuf(pTHX_ PerlIO *f)
 {
-    if (f) {
+    if (PerlIOValid(f)) {
 	PerlIOBase(f)->flags |= PERLIO_F_LINEBUF;
     }
 }
@@ -1926,7 +1998,7 @@ PerlIO *
 PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
 {
     PerlIO *nexto = PerlIONext(o);
-    if (*nexto) {
+    if (PerlIOValid(nexto)) {
 	PerlIO_funcs *tab = PerlIOBase(nexto)->tab;
 	f = (*tab->Dup)(aTHX_ f, nexto, param, flags);
     }
@@ -2091,6 +2163,8 @@ PerlIOUnix_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
     IV code = PerlIOBase_pushed(aTHX_ f, mode, arg);
     PerlIOUnix *s = PerlIOSelf(f, PerlIOUnix);
     if (*PerlIONext(f)) {
+	/* We never call down so any pending stuff now */
+	PerlIO_flush(PerlIONext(f));
 	s->fd = PerlIO_fileno(PerlIONext(f));
 	/*
 	 * XXX could (or should) we retrieve the oflags from the open file
@@ -2322,8 +2396,11 @@ PerlIOStdio_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
 	FILE *stdio =
 	    PerlSIO_fdopen(PerlIO_fileno(PerlIONext(f)), mode =
 			   PerlIOStdio_mode(mode, tmode));
-	if (stdio)
+	if (stdio) {
 	    s->stdio = stdio;
+	    /* We never call down so any pending stuff now */
+	    PerlIO_flush(PerlIONext(f));
+	}
 	else
 	    return -1;
     }
@@ -2460,8 +2537,7 @@ PerlIOStdio_close(pTHX_ PerlIO *f)
     FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
     if (PerlIOUnix_refcnt_dec(fileno(stdio)) > 0) {
 	/* Do not close it but do flush any buffers */
-	PerlIO_flush(f);
-	return 0;
+        return PerlIO_flush(f);
     }
     return (
 #ifdef SOCKS5_VERSION_NAME
@@ -2785,21 +2861,17 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 	       IV n, const char *mode, int fd, int imode, int perm,
 	       PerlIO *f, int narg, SV **args)
 {
-    if (f) {
+    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,
+	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) != 0) {
 	    return NULL;
 	}
     }
     else {
-	PerlIO_funcs *tab =
-	    PerlIO_layer_fetch(aTHX_ layers, n - 1, PerlIO_default_btm());
+	PerlIO_funcs *tab = PerlIO_layer_fetch(aTHX_ layers, n - 1, PerlIO_default_btm());
 	int init = 0;
 	if (*mode == 'I') {
 	    init = 1;
@@ -2818,18 +2890,23 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 		return NULL;
 	    } else {
 		fd = PerlIO_fileno(f);
-#ifdef PERLIO_USING_CRLF
-		/*
-		 * do something about failing setmode()? --jhi
-		 */
-		PerlLIO_setmode(fd, O_BINARY);
-#endif
 		if (init && fd == 2) {
 		    /*
 		     * Initial stderr is unbuffered
 		     */
 		    PerlIOBase(f)->flags |= PERLIO_F_UNBUF;
 		}
+#ifdef PERLIO_USING_CRLF
+#  ifdef PERLIO_IS_BINMODE_FD
+		if (PERLIO_IS_BINMODE_FD(fd))
+		    PerlIO_binmode(f,  '<'/*not used*/, O_BINARY, Nullch);
+		else
+#  endif
+		/*
+		 * do something about failing setmode()? --jhi
+		 */
+		PerlLIO_setmode(fd, O_BINARY);
+#endif
 	    }
 	}
     }
@@ -2845,13 +2922,13 @@ PerlIOBuf_flush(pTHX_ PerlIO *f)
 {
     PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
     int code = 0;
+    PerlIO *n = PerlIONext(f);
     if (PerlIOBase(f)->flags & PERLIO_F_WRBUF) {
 	/*
 	 * write() the buffer
 	 */
 	STDCHAR *buf = b->buf;
 	STDCHAR *p = buf;
-	PerlIO *n = PerlIONext(f);
 	while (p < b->ptr) {
 	    SSize_t count = PerlIO_write(n, p, b->ptr - p);
 	    if (count > 0) {
@@ -2875,17 +2952,17 @@ PerlIOBuf_flush(pTHX_ PerlIO *f)
 	    /*
 	     * We did not consume all of it
 	     */
-	    if (PerlIO_seek(PerlIONext(f), b->posn, SEEK_SET) == 0) {
-		b->posn = PerlIO_tell(PerlIONext(f));
+	    if (PerlIO_seek(n, b->posn, SEEK_SET) == 0) {
+		/* Reload n as some layers may pop themselves on seek */
+		b->posn = PerlIO_tell(n = PerlIONext(f));
 	    }
 	}
     }
     b->ptr = b->end = b->buf;
     PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF);
-    /*
-     * FIXME: Is this right for read case ?
-     */
-    if (PerlIO_flush(PerlIONext(f)) != 0)
+    /* We check for Valid because of dubious decision to make PerlIO_flush(NULL) flush all */
+    /* FIXME: Doing downstream flush may be sub-optimal see PerlIOBuf_fill() below */
+    if (PerlIOValid(n) && PerlIO_flush(n) != 0)
 	code = -1;
     return code;
 }
@@ -2897,10 +2974,10 @@ PerlIOBuf_fill(pTHX_ PerlIO *f)
     PerlIO *n = PerlIONext(f);
     SSize_t avail;
     /*
-     * FIXME: doing the down-stream flush is a bad idea if it causes
-     * pre-read data in stdio buffer to be discarded but this is too
-     * simplistic - as it skips _our_ hosekeeping and breaks tell tests.
-     * if (!(PerlIOBase(f)->flags & PERLIO_F_RDBUF)) { }
+     * FIXME: doing the down-stream flush maybe sub-optimal if it causes
+     * pre-read data in stdio buffer to be discarded.
+     * However, skipping the flush also skips _our_ hosekeeping
+     * and breaks tell tests. So we do the flush.
      */
     if (PerlIO_flush(f) != 0)
 	return -1;
@@ -2913,7 +2990,7 @@ PerlIOBuf_fill(pTHX_ PerlIO *f)
     b->ptr = b->end = b->buf;
     if (PerlIO_fast_gets(n)) {
 	/*
-	 * Layer below is also buffered We do _NOT_ want to call its
+	 * Layer below is also buffered. We do _NOT_ want to call its
 	 * ->Read() because that will loop till it gets what we asked for
 	 * which may hang on a pipe etc. Instead take anything it has to
 	 * hand, or ask it to fill _once_.
@@ -2956,7 +3033,7 @@ SSize_t
 PerlIOBuf_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 {
     PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
-    if (f) {
+    if (PerlIOValid(f)) {
 	if (!b->ptr)
 	    PerlIO_get_base(f);
 	return PerlIOBase_read(aTHX_ f, vbuf, count);
@@ -3419,8 +3496,8 @@ PerlIOCrlf_get_cnt(pTHX_ PerlIO *f)
 	PerlIO_get_base(f);
     if (PerlIOBase(f)->flags & PERLIO_F_RDBUF) {
 	PerlIOCrlf *c = PerlIOSelf(f, PerlIOCrlf);
-	if ((PerlIOBase(f)->flags & PERLIO_F_CRLF) && !c->nl) {
-	    STDCHAR *nl = b->ptr;
+	if ((PerlIOBase(f)->flags & PERLIO_F_CRLF) && (!c->nl || *c->nl == 0xd)) {
+	    STDCHAR *nl = (c->nl) ? c->nl : b->ptr;
 	  scan:
 	    while (nl < b->end && *nl != 0xd)
 		nl++;
@@ -3485,7 +3562,6 @@ PerlIOCrlf_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt)
 {
     PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
     PerlIOCrlf *c = PerlIOSelf(f, PerlIOCrlf);
-    IV flags = PerlIOBase(f)->flags;
     if (!b->buf)
 	PerlIO_get_base(f);
     if (!ptr) {
@@ -3502,9 +3578,11 @@ PerlIOCrlf_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt)
 	ptr -= cnt;
     }
     else {
+#if 0
 	/*
 	 * Test code - delete when it works ...
 	 */
+	IV flags = PerlIOBase(f)->flags;
 	STDCHAR *chk = (c->nl) ? (c->nl+1) : b->end;
         if (ptr+cnt == c->nl && c->nl+1 == b->end && *c->nl == 0xd) {
 	  /* Defered CR at end of buffer case - we lied about count */
@@ -3513,10 +3591,11 @@ PerlIOCrlf_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt)
 	chk -= cnt;
 
 	if (ptr != chk ) {
-	    Perl_warn(aTHX_ "ptr wrong %p != %p fl=%08" UVxf
+	    Perl_croak(aTHX_ "ptr wrong %p != %p fl=%08" UVxf
 		       " nl=%p e=%p for %d", ptr, chk, flags, c->nl,
 		       b->end, cnt);
 	}
+#endif
     }
     if (c->nl) {
 	if (ptr > c->nl) {