Die on n-arg open(...,"",xxx,yyy,...)

 - redirect pipe cases to PerlProc_popen_list() (which just croaks for now)
 - die on read/write cases so we can decide what it means later.

p4raw-id: //depot/perlio@9294

4 files changed, 45 insertions, 10 deletions

diff --git a/doio.c b/doio.c
index 3ed517b0bd..67fa665806 100644
--- a/doio.c
+++ b/doio.c
@@ -132,6 +132,9 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 
     if (as_raw) {
         /* sysopen style args, i.e. integer mode and permissions */
+	if (num_svs != 0) {
+	     Perl_croak(aTHX_ "panic:sysopen with multiple args");
+	}
 
 #if defined(USE_64_BIT_RAWIO) && defined(O_LARGEFILE)
 	rawmode |= O_LARGEFILE;
@@ -234,7 +237,8 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 		name = type;
 		len = tend-type;
 	    }
-	    if (*name == '\0') { /* command is missing 19990114 */
+	    if (*name == '\0') {
+		/* command is missing 19990114 */
 		if (ckWARN(WARN_PIPE))
 		    Perl_warner(aTHX_ WARN_PIPE, "Missing command in piped open");
 		errno = EPIPE;
@@ -254,7 +258,12 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 		strcat(mode, "b");
 	    else if (out_crlf)
 		strcat(mode, "t");
-	    fp = PerlProc_popen(name,mode);
+	    if (num_svs > 1) {
+		fp = PerlProc_popen_list(mode, num_svs, svp);
+	    }
+	    else {
+		fp = PerlProc_popen(name,mode);
+	    }
 	}
 	else if (*type == IoTYPE_WRONLY) {
 	    TAINT_PROPER("open");
@@ -276,15 +285,17 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 	    if (*type == '&') {
 		name = type;
 	      duplicity:
-		if (num_svs)
-		    goto unknown_desr;
 		dodup = 1;
 		name++;
 		if (*name == '=') {
 		    dodup = 0;
 		    name++;
 		}
+		if (num_svs) {
+		    goto unknown_desr;
+		}
 		if (!*name && supplied_fp)
+		    /* "<+&" etc. is used by typemaps */
 		    fp = supplied_fp;
 		else {
 		    /*SUPPRESS 530*/
@@ -347,6 +358,9 @@ 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] == ':')) {
@@ -361,6 +375,9 @@ 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';
@@ -396,7 +413,8 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 		name = type;
 	        len  = tend-type;
 	    }
-	    if (*name == '\0') { /* command is missing 19990114 */
+	    if (*name == '\0') {
+		/* command is missing 19990114 */
 		if (ckWARN(WARN_PIPE))
 		    Perl_warner(aTHX_ WARN_PIPE, "Missing command in piped open");
 		errno = EPIPE;
@@ -410,7 +428,13 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 		strcat(mode, "b");
 	    else if (in_crlf)
 		strcat(mode, "t");
-	    fp = PerlProc_popen(name,mode);
+	    if (num_svs > 1) {
+		fp = PerlProc_popen_list(mode,num_svs,svp);
+	    }
+	    else
+            {
+		fp = PerlProc_popen(name,mode);
+	    }
 	    IoTYPE(io) = IoTYPE_PIPE;
 	}
 	else {
diff --git a/embed.pl b/embed.pl
index cb2b4a71db..7867892e51 100755
--- a/embed.pl
+++ b/embed.pl
@@ -1772,6 +1772,7 @@ Anp	|void*	|my_memset	|char* loc|I32 ch|I32 len
 #if !defined(PERL_OBJECT)
 Ap	|I32	|my_pclose	|PerlIO* ptr
 Ap	|PerlIO*|my_popen	|char* cmd|char* mode
+Ap	|PerlIO*|my_popen_list	|char* mode|int n|SV ** args
 #endif
 Ap	|void	|my_setenv	|char* nam|char* val
 Ap	|I32	|my_stat
diff --git a/iperlsys.h b/iperlsys.h
index fdbd12a6fc..8a628cd658 100644
--- a/iperlsys.h
+++ b/iperlsys.h
@@ -253,7 +253,7 @@ struct IPerlStdIOInfo
 #define PerlSIO_printf		Perl_fprintf_nocontext
 #define PerlSIO_stdoutf		Perl_printf_nocontext
 #define PerlSIO_vprintf(f,fmt,a)						\
-	(*PL_StdIO->pVprintf)(PL_StdIO, (f),(fmt),a)          
+	(*PL_StdIO->pVprintf)(PL_StdIO, (f),(fmt),a)
 #define PerlSIO_ftell(f)							\
 	(*PL_StdIO->pTell)(PL_StdIO, (f))
 #define PerlSIO_fseek(f,o,w)						\
@@ -982,6 +982,8 @@ struct IPerlProcInfo
 	(*PL_Proc->pPauseProc)(PL_Proc)
 #define PerlProc_popen(c, m)						\
 	(*PL_Proc->pPopen)(PL_Proc, (c), (m))
+#define PerlProc_popen_list(m, n, a)					\
+	(*PL_Proc->pPopenList)(PL_Proc, (m), (n), (a))
 #define PerlProc_pclose(f)						\
 	(*PL_Proc->pPclose)(PL_Proc, (f))
 #define PerlProc_pipe(fd)						\
@@ -1043,6 +1045,7 @@ struct IPerlProcInfo
 #define PerlProc_killpg(i, a)	killpg((i), (a))
 #define PerlProc_pause()	Pause()
 #define PerlProc_popen(c, m)	my_popen((c), (m))
+#define PerlProc_popen_list(m,n,a)	my_popen_list((m),(n),(a))
 #define PerlProc_pclose(f)	my_pclose((f))
 #define PerlProc_pipe(fd)	pipe((fd))
 #define PerlProc_setuid(u)	setuid((u))
diff --git a/util.c b/util.c
index e24a81d19f..25286ac0e1 100644
--- a/util.c
+++ b/util.c
@@ -2309,6 +2309,13 @@ VTOH(vtohs,short)
 VTOH(vtohl,long)
 #endif
 
+PerlIO *
+Perl_my_popen_list(pTHX_ char *mode, int n, SV **args)
+{
+    Perl_croak(aTHX_ "List form of piped open not implemented");
+    return (PerlIO *) NULL;
+}
+
     /* VMS' my_popen() is in VMS.c, same with OS/2. */
 #if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) && !defined(MACOS_TRADITIONAL)
 PerlIO *
@@ -3969,14 +3976,14 @@ Perl_ebcdic_control(pTHX_ int ch)
 {
     	if (ch > 'a') {
 	        char *ctlp;
- 
+
  	       if (islower(ch))
   	              ch = toupper(ch);
- 
+
  	       if ((ctlp = strchr(controllablechars, ch)) == 0) {
   	              Perl_die(aTHX_ "unrecognised control character '%c'\n", ch);
      	       }
- 
+
         	if (ctlp == controllablechars)
          	       return('\177'); /* DEL */
         	else