From: Nick Ing-Simmons <nik@tiuk.ti.com>
Date: Sat, 8 Dec 2001 10:20:06 +0000 (+0000)
Subject: Allow multi-arg open() if opening layer declares this legal.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7cf31bebccd8b4045fd1d586b26bef41a901c2d0;p=p5sagit%2Fp5-mst-13.2.git

Allow multi-arg open() if opening layer declares this legal.

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

diff --git a/doio.c b/doio.c
index abf9ae5..ed57c42 100644
--- a/doio.c
+++ b/doio.c
@@ -359,9 +359,6 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 		}
 	    } /* & */
 	    else {
-		if (num_svs > 1) {
-		    Perl_croak(aTHX_ "More than one argument to '>' open");
-		}
 		/*SUPPRESS 530*/
 		for (; isSPACE(*type); type++) ;
 		if (*type == IoTYPE_STD && (!type[1] || isSPACE(type[1]) || type[1] == ':')) {
@@ -369,6 +366,9 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 		    type++;
 		    fp = PerlIO_stdout();
 		    IoTYPE(io) = IoTYPE_STD;
+		    if (num_svs > 1) {
+			Perl_croak(aTHX_ "More than one argument to '>%c' open",IoTYPE_STD);
+		    }
 		}
 		else  {
 		    if (!num_svs) {
@@ -382,9 +382,6 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 	    } /* !& */
 	}
 	else if (*type == IoTYPE_RDONLY) {
-	    if (num_svs > 1) {
-		Perl_croak(aTHX_ "More than one argument to '<' open");
-	    }
 	    /*SUPPRESS 530*/
 	    for (type++; isSPACE(*type); type++) ;
 	    mode[0] = 'r';
@@ -401,6 +398,9 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 		type++;
 		fp = PerlIO_stdin();
 		IoTYPE(io) = IoTYPE_STD;
+		if (num_svs > 1) {
+		    Perl_croak(aTHX_ "More than one argument to '<%c' open",IoTYPE_STD);
+		}
 	    }
 	    else {
 		if (!num_svs) {
diff --git a/perlio.c b/perlio.c
index 7c16e43..0a43901 100644
--- a/perlio.c
+++ b/perlio.c
@@ -208,7 +208,10 @@ PerlIO *
 PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
 	     int imode, int perm, PerlIO *old, int narg, SV **args)
 {
-    if (narg == 1) {
+    if (narg) {
+	if (narg > 1) {
+	    Perl_croak(aTHX_ "More than one argument to '%s' open",mode);
+	}
 	if (*args == &PL_sv_undef)
 	    return PerlIO_tmpfile();
 	else {
@@ -1283,6 +1286,9 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
 	    /*
 	     * Found that layer 'n' can do opens - call it
 	     */
+	    if (narg > 1 && !(tab->kind & PERLIO_K_MULTIARG)) {
+		Perl_croak(aTHX_ "More than one argument to '%s' open",mode);
+	    }
 	    PerlIO_debug("openn(%s,'%s','%s',%d,%x,%o,%p,%d,%p)\n",
 			 tab->name, layers, mode, fd, imode, perm, f, narg,
 			 args);
diff --git a/perliol.h b/perliol.h
index 226de6a..d133061 100644
--- a/perliol.h
+++ b/perliol.h
@@ -58,6 +58,7 @@ struct _PerlIO_funcs {
 #define PERLIO_K_DUMMY		0x00000010
 #define PERLIO_K_UTF8		0x00008000
 #define PERLIO_K_DESTRUCT	0x00010000
+#define PERLIO_K_MULTIARG	0x00020000
 
 /*--------------------------------------------------------------------------------------*/
 struct _PerlIO {