Make open fail when layer string does not parse.

p4raw-id: //depot/perlio@16613

diff --git a/MANIFEST b/MANIFEST
index 6c00f87..b907782 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -529,6 +529,7 @@ ext/PerlIO/Scalar/Makefile.PL       PerlIO layer for scalars
 ext/PerlIO/Scalar/Scalar.pm    PerlIO layer for scalars
 ext/PerlIO/Scalar/Scalar.xs    PerlIO layer for scalars
 ext/PerlIO/t/encoding.t                See if PerlIO encoding conversion works
+ext/PerlIO/t/fail.t            See if bad layers fail
 ext/PerlIO/t/fallback.t                See if PerlIO fallbacks work
 ext/PerlIO/t/scalar.t          See if PerlIO::Scalar works
 ext/PerlIO/t/via.t             See if PerlIO::Via works

diff --git a/ext/PerlIO/t/fail.t b/ext/PerlIO/t/fail.t
new file mode 100644 (file)
index 0000000..87d2764
--- /dev/null
+++ b/ext/PerlIO/t/fail.t
@@ -0,0 +1,45 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require "../t/test.pl";
+    skip_all("No perlio") unless (find PerlIO::Layer 'perlio');
+    plan (16);
+}
+
+use warnings 'layer';
+my $warn;
+my $file = "fail$$";
+$SIG{__WARN__} = sub { $warn = shift };
+
+END { 1 while unlink($file) }
+
+ok(open(FH,">",$file),"Create works");
+close(FH);
+ok(open(FH,"<",$file),"Normal open works");
+
+$warn = ''; $! = 0;
+ok(!binmode(FH,":-)"),"All punctuation fails binmode");
+like($!,'Invalid',"Got errno");
+like($warn,qr/in layer/,"Got warning");
+
+$warn = ''; $! = 0;
+ok(!binmode(FH,":nonesuch"),"Bad package fails binmode");
+like($!,'No such',"Got errno");
+like($warn,qr/nonesuch/,"Got warning");
+close(FH);
+
+$warn = ''; $! = 0;
+ok(!open(FH,"<:-)",$file),"All punctuation fails open");
+like($!,"Invalid","Got errno");
+like($warn,qr/in layer/,"Got warning");
+isnt($!,"","Got errno");
+
+$warn = ''; $! = 0;
+ok(!open(FH,"<:nonesuch",$file),"Bad package fails open");
+like($!,"No such","Got errno");
+like($warn,qr/nonesuch/,"Got warning");
+
+ok(open(FH,"<",$file),"Normal open (still) works");
+close(FH);

diff --git a/perlio.c b/perlio.c
index 78d6380..3ece5e0 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -805,6 +805,7 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
                        Perl_warner(aTHX_ packWARN(WARN_LAYER),
                              "perlio: invalid separator character %c%c%c in layer specification list %s",
                              q, *s, q, s);
+                   SETERRNO(EINVAL, LIB$_INVARG);
                    return -1;
                }
                do {
@@ -1287,8 +1288,13 @@ PerlIO_resolve_layers(pTHX_ const char *layers,
        else {
            av = def;
        }
-       PerlIO_parse_layers(aTHX_ av, layers);
-       return av;
+       if (PerlIO_parse_layers(aTHX_ av, layers) == 0) {
+            return av;
+       }
+       else {
+           PerlIO_list_free(aTHX_ av);
+           return (PerlIO_list_t *) NULL;
+       }
     }
     else {
        if (incdef)
@@ -1330,6 +1336,9 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
        }
        else {
            layera = PerlIO_resolve_layers(aTHX_ layers, mode, narg, args);
+           if (!layera) {
+               return NULL;
+           }
        }
        /*
         * Start at "top" of layer stack