[REPATCH] Re: PerlIOBuf_dup

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

p4raw-id: //depot/perl@12839

diff --git a/ext/Encode/Encode.xs b/ext/Encode/Encode.xs
index 299af44..e7d8c6f 100644 (file)
--- 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 dc2b2ba..590fc00 100644 (file)
--- 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 f102600..f74e569 100644 (file)
--- 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;
+               }
            }
        }
     }