From: Nick Ing-Simmons <nik@tiuk.ti.com>
Date: Wed, 15 May 2002 19:26:00 +0000 (+0000)
Subject: Make open fail when layer string does not parse.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0cff2cf3dc85787c2786f644ac6406c6b5148dad;p=p5sagit%2Fp5-mst-13.2.git

Make open fail when layer string does not parse.

p4raw-id: //depot/perlio@16613
---

diff --git a/MANIFEST b/MANIFEST
index 6c00f87..b907782 100644
--- 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
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
--- 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