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 (file)
--- 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 (file)
--- 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 (file)
--- 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 {