[REPATCH] Re: PerlIOBuf_dup

Message-ID: <20011104104123.U20123@plum.flirble.org>

p4raw-id: //depot/perl@12839

3 files changed, 41 insertions, 15 deletions

diff --git a/ext/Encode/Encode.xs b/ext/Encode/Encode.xs
index 299af4471f..e7d8c6f5c7 100644
--- a/ext/Encode/Encode.xs
+++ b/ext/Encode/Encode.xs
@@ -102,12 +102,15 @@ PerlIOEncode_pushed(PerlIO *f, const char *mode, SV *arg)
    e->enc = Nullsv;
    errno  = EINVAL;
    Perl_warner(aTHX_ WARN_IO, "Cannot find encoding \"%"SVf"\"", arg);
-   return -1;
+   code = -1;
+  }
+ else
+  {
+   SvREFCNT_inc(e->enc);
+   PerlIOBase(f)->flags |= PERLIO_F_UTF8;
   }
- SvREFCNT_inc(e->enc);
  FREETMPS;
  LEAVE;
- PerlIOBase(f)->flags |= PERLIO_F_UTF8;
  return code;
 }
 
diff --git a/ext/PerlIO/t/encoding.t b/ext/PerlIO/t/encoding.t
index dc2b2ba864..590fc00266 100644
--- a/ext/PerlIO/t/encoding.t
+++ b/ext/PerlIO/t/encoding.t
@@ -9,10 +9,11 @@ BEGIN {
     }
 }
 
-print "1..8\n";
+print "1..10\n";
 
 my $grk = "grk$$";
 my $utf = "utf$$";
+my $fail1 = "fail$$";
 
 if (open(GRK, ">$grk")) {
     # alpha beta gamma in ISO 8859-7
@@ -57,6 +58,21 @@ if (open(GRK, "<$grk")) {
     close GRK;
 }
 
+$SIG{__WARN__} = sub {$warn = $_[0]};
+
+if (open(FAIL, ">:encoding(NoneSuch)", $fail1)) {
+    print "not ok 9 # Open should fail\n";
+} else {
+    print "ok 9\n";
+}
+if (!defined $warn) {
+    print "not ok 10 # warning is undef\n";
+} elsif ($warn =~ /^Cannot find encoding "NoneSuch" at/) {
+    print "ok 10\n";
+} else {
+    print "not ok 10 # warning is '$warn'";
+}
+
 END {
-    unlink($grk, $utf);
+    unlink($grk, $utf, $fail1);
 }
diff --git a/perlio.c b/perlio.c
index f102600cdf..f74e5694fa 100644
--- a/perlio.c
+++ b/perlio.c
@@ -2872,19 +2872,26 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 	f = (*tab->Open) (aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
 			  NULL, narg, args);
 	if (f) {
-	    PerlIO_push(aTHX_ f, self, mode, PerlIOArg);
-	    fd = PerlIO_fileno(f);
+            if (PerlIO_push(aTHX_ f, self, mode, PerlIOArg) == 0) {
+		/*
+		 * if push fails during open, open fails. close will pop us.
+		 */
+		PerlIO_close (f);
+		return NULL;
+	    } else {
+		fd = PerlIO_fileno(f);
 #if (O_BINARY != O_TEXT) && !defined(__BEOS__)
-	    /*
-	     * do something about failing setmode()? --jhi
-	     */
-	    PerlLIO_setmode(fd, O_BINARY);
-#endif
-	    if (init && fd == 2) {
 		/*
-		 * Initial stderr is unbuffered
+		 * do something about failing setmode()? --jhi
 		 */
-		PerlIOBase(f)->flags |= PERLIO_F_UNBUF;
+		PerlLIO_setmode(fd, O_BINARY);
+#endif
+		if (init && fd == 2) {
+		    /*
+		     * Initial stderr is unbuffered
+		     */
+		    PerlIOBase(f)->flags |= PERLIO_F_UNBUF;
+		}
 	    }
 	}
     }