Infrastructure to allow:

  open($fh,"|-",@array);
to be implemented
i.e. mark pp_open as needing a stack mark, and make pp_open
process its args in that style (and pass them _all_ to tied handles OPEN).
Invent do_openn() which takes SV ** at allow it to see multiple args.
Note this does not _do_ anything yet.

p4raw-id: //depot/perlio@8484

diff --git a/doio.c b/doio.c
index 2bccc73..6056ea7 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -55,8 +55,8 @@ bool
 Perl_do_open(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
             int rawmode, int rawperm, PerlIO *supplied_fp)
 {
-    return do_open9(gv, name, len, as_raw, rawmode, rawperm,
-                   supplied_fp, Nullsv, 0);
+    return do_openn(gv, name, len, as_raw, rawmode, rawperm,
+                   supplied_fp, (SV **) NULL, 0);
 }
 
 bool
@@ -64,6 +64,15 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
              int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs,
              I32 num_svs)
 {
+    return do_openn(gv, name, len, as_raw, rawmode, rawperm,
+                   supplied_fp, &svs, 1);
+}
+
+bool
+Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
+             int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp,
+             I32 num_svs)
+{
     register IO *io = GvIOn(gv);
     PerlIO *saveifp = Nullfp;
     PerlIO *saveofp = Nullfp;
@@ -77,6 +86,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
     char *type  = NULL;
     char *deftype = NULL;
     char mode[4];              /* stdio file mode ("r\0", "rb\0", "r+b\0" etc.) */
+    SV *svs = (num_svs) ? *svp : Nullsv;
 
     Zero(mode,sizeof(mode),char);
     PL_forkprocess = 1;                /* assume true if no fork */
@@ -529,6 +539,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
     if (type) {
        while (isSPACE(*type)) type++;
        if (*type) {
+          errno = 0;
           if (PerlIO_apply_layers(aTHX_ IoIFP(io),mode,type) != 0) {
                goto say_false;
           }

diff --git a/embed.h b/embed.h
index ce90e59..c7314bb 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -182,6 +182,7 @@
 #define do_kv                  Perl_do_kv
 #define do_open                        Perl_do_open
 #define do_open9               Perl_do_open9
+#define do_openn               Perl_do_openn
 #define do_pipe                        Perl_do_pipe
 #define do_print               Perl_do_print
 #define do_readline            Perl_do_readline
@@ -1664,6 +1665,7 @@
 #define do_kv()                        Perl_do_kv(aTHX)
 #define do_open(a,b,c,d,e,f,g) Perl_do_open(aTHX_ a,b,c,d,e,f,g)
 #define do_open9(a,b,c,d,e,f,g,h,i)    Perl_do_open9(aTHX_ a,b,c,d,e,f,g,h,i)
+#define do_openn(a,b,c,d,e,f,g,h,i)    Perl_do_openn(aTHX_ a,b,c,d,e,f,g,h,i)
 #define do_pipe(a,b,c)         Perl_do_pipe(aTHX_ a,b,c)
 #define do_print(a,b)          Perl_do_print(aTHX_ a,b)
 #define do_readline()          Perl_do_readline(aTHX)
@@ -3261,6 +3263,8 @@
 #define do_open                        Perl_do_open
 #define Perl_do_open9          CPerlObj::Perl_do_open9
 #define do_open9               Perl_do_open9
+#define Perl_do_openn          CPerlObj::Perl_do_openn
+#define do_openn               Perl_do_openn
 #define Perl_do_pipe           CPerlObj::Perl_do_pipe
 #define do_pipe                        Perl_do_pipe
 #define Perl_do_print          CPerlObj::Perl_do_print

diff --git a/embed.pl b/embed.pl
index 9c10252..339956e 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -1494,6 +1494,9 @@ Ap        |bool   |do_open        |GV* gv|char* name|I32 len|int as_raw \
 Ap     |bool   |do_open9       |GV *gv|char *name|I32 len|int as_raw \
                                |int rawmode|int rawperm|PerlIO *supplied_fp \
                                |SV *svs|I32 num
+Ap     |bool   |do_openn       |GV *gv|char *name|I32 len|int as_raw \
+                               |int rawmode|int rawperm|PerlIO *supplied_fp \
+                               |SV **svp|I32 num
 p      |void   |do_pipe        |SV* sv|GV* rgv|GV* wgv
 p      |bool   |do_print       |SV* sv|PerlIO* fp
 p      |OP*    |do_readline

diff --git a/objXSUB.h b/objXSUB.h
index 60c6e90..5867ed2 100644 (file)
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -325,6 +325,10 @@
 #define Perl_do_open9          pPerl->Perl_do_open9
 #undef  do_open9
 #define do_open9               Perl_do_open9
+#undef  Perl_do_openn
+#define Perl_do_openn          pPerl->Perl_do_openn
+#undef  do_openn
+#define do_openn               Perl_do_openn
 #undef  Perl_dowantarray
 #define Perl_dowantarray       pPerl->Perl_dowantarray
 #undef  dowantarray

diff --git a/opcode.h b/opcode.h
index 542ec60..42f4d9d 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -1,4 +1,4 @@
-/* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
+/* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
    This file is built by opcode.pl from its data.  Any changes made here
    will be lost!
 */
@@ -1643,7 +1643,7 @@ EXT U32 PL_opargs[] = {
        0x00001a44,     /* dump */
        0x00001a44,     /* goto */
        0x00013644,     /* exit */
-       0x0052c81c,     /* open */
+       0x0052c81d,     /* open */
        0x0001d614,     /* close */
        0x000cc814,     /* pipe_op */
        0x0000d61c,     /* fileno */

diff --git a/opcode.pl b/opcode.pl
index 2e6ae01..5b0933e 100755 (executable)
--- a/opcode.pl
+++ b/opcode.pl
@@ -31,7 +31,7 @@ while (<DATA>) {
 
 $i = 0;
 print <<"END";
-/* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
+/* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
    This file is built by opcode.pl from its data.  Any changes made here
    will be lost!
 */
@@ -44,7 +44,7 @@ print <<"END";
 END
 
 print ON <<"END";
-/* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
+/* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
    This file is built by opcode.pl from its data.  Any changes made here
    will be lost!
 */
@@ -93,7 +93,7 @@ END
 for (@ops) {
     my($safe_desc) = $desc{$_};
 
-    # Have to escape double quotes and escape characters.    
+    # Have to escape double quotes and escape characters.
     $safe_desc =~ s/(^|[^\\])([\\"])/$1\\$2/g;
 
     print qq(\t"$safe_desc",\n);
@@ -262,7 +262,7 @@ open PP, '>pp_proto.h' or die "Error creating pp_proto.h: $!";
 open PPSYM, '>pp.sym' or die "Error creating pp.sym: $!";
 
 print PP <<"END";
-/* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
+/* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
    This file is built by opcode.pl from its data.  Any changes made here
    will be lost!
 */
@@ -271,7 +271,7 @@ END
 
 print PPSYM <<"END";
 #
-# !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
+# !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
 #   This file is built by opcode.pl from its data.  Any changes made here
 #   will be lost!
 #
@@ -630,7 +630,7 @@ exit                exit                    ck_exit         ds%     S?
 
 # I/O.
 
-open           open                    ck_open         ist@    F S? L
+open           open                    ck_open         ismt@   F S? L
 close          close                   ck_fun          is%     F?
 pipe_op                pipe                    ck_fun          is@     F F
 

diff --git a/opnames.h b/opnames.h
index 16b2f02..ac726b9 100644 (file)
--- a/opnames.h
+++ b/opnames.h
@@ -1,4 +1,4 @@
-/* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
+/* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
    This file is built by opcode.pl from its data.  Any changes made here
    will be lost!
 */

diff --git a/perlapi.c b/perlapi.c
index bb32970..fb69281 100644 (file)
--- a/perlapi.c
+++ b/perlapi.c
@@ -656,6 +656,13 @@ Perl_do_open9(pTHXo_ GV *gv, char *name, I32 len, int as_raw, int rawmode, int r
     return ((CPerlObj*)pPerl)->Perl_do_open9(gv, name, len, as_raw, rawmode, rawperm, supplied_fp, svs, num);
 }
 
+#undef  Perl_do_openn
+bool
+Perl_do_openn(pTHXo_ GV *gv, char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp, I32 num)
+{
+    return ((CPerlObj*)pPerl)->Perl_do_openn(gv, name, len, as_raw, rawmode, rawperm, supplied_fp, svp, num);
+}
+
 #undef  Perl_dowantarray
 I32
 Perl_dowantarray(pTHXo)

diff --git a/pp_proto.h b/pp_proto.h
index c3b24e8..d6d626f 100644 (file)
--- a/pp_proto.h
+++ b/pp_proto.h
@@ -1,4 +1,4 @@
-/* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
+/* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
    This file is built by opcode.pl from its data.  Any changes made here
    will be lost!
 */

diff --git a/pp_sys.c b/pp_sys.c
index 32fd686..8d3200e 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -492,7 +492,9 @@ PP(pp_die)
 
 PP(pp_open)
 {
-    djSP; dTARGET;
+    djSP;
+    dMARK; dORIGMARK;
+    dTARGET;
     GV *gv;
     SV *sv;
     SV *name = Nullsv;
@@ -500,29 +502,19 @@ PP(pp_open)
     char *tmps;
     STRLEN len;
     MAGIC *mg;
+    bool  ok;
 
-    if (MAXARG > 2) {
-       name = POPs;
-       have_name = 1;
-    }
-    if (MAXARG > 1)
-       sv = POPs;
-    if (!isGV(TOPs))
-       DIE(aTHX_ PL_no_usym, "filehandle");
-    if (MAXARG <= 1)
-       sv = GvSV(TOPs);
-    gv = (GV*)POPs;
+    gv = (GV *)*++MARK;
     if (!isGV(gv))
        DIE(aTHX_ PL_no_usym, "filehandle");
     if (GvIOp(gv))
        IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
 
     if ((mg = SvTIED_mg((SV*)gv, 'q'))) {
-       PUSHMARK(SP);
-       XPUSHs(SvTIED_obj((SV*)gv, mg));
-       XPUSHs(sv);
-       if (have_name)
-           XPUSHs(name);
+       /* Method's args are same as ours ... */
+       /* ... except handle is replaced by the object */
+       *MARK-- = SvTIED_obj((SV*)gv, mg);
+       PUSHMARK(MARK);
        PUTBACK;
        ENTER;
        call_method("OPEN", G_SCALAR);
@@ -531,8 +523,17 @@ PP(pp_open)
        RETURN;
     }
 
+    if (MARK < SP) {
+       sv = *++MARK;
+    }
+    else {
+       sv = GvSV(gv);
+    }
+
     tmps = SvPV(sv, len);
-    if (do_open9(gv, tmps, len, FALSE, O_RDONLY, 0, Nullfp, name, have_name))
+    ok = do_openn(gv, tmps, len, FALSE, O_RDONLY, 0, Nullfp, MARK+1, (SP-MARK));
+    SP = ORIGMARK;
+    if (ok)
        PUSHi( (I32)PL_forkprocess );
     else if (PL_forkprocess == 0)              /* we are a new child */
        PUSHi(0);
@@ -3602,7 +3603,7 @@ PP(pp_mkdir)
      * trailing slashes.  To err on the side of portability, we
      * snip away one trailing slash. */
     if (tmps[len-1] == '/') {
-       tmps = savepvn(tmps, len - 1); 
+       tmps = savepvn(tmps, len - 1);
        copy = TRUE;
     }
 

diff --git a/proto.h b/proto.h
index 00b2ef0..13efc48 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -236,6 +236,7 @@ PERL_CALLCONV void  Perl_do_join(pTHX_ SV* sv, SV* del, SV** mark, SV** sp);
 PERL_CALLCONV OP*      Perl_do_kv(pTHX);
 PERL_CALLCONV bool     Perl_do_open(pTHX_ GV* gv, char* name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO* supplied_fp);
 PERL_CALLCONV bool     Perl_do_open9(pTHX_ GV *gv, char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs, I32 num);
+PERL_CALLCONV bool     Perl_do_openn(pTHX_ GV *gv, char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp, I32 num);
 PERL_CALLCONV void     Perl_do_pipe(pTHX_ SV* sv, GV* rgv, GV* wgv);
 PERL_CALLCONV bool     Perl_do_print(pTHX_ SV* sv, PerlIO* fp);
 PERL_CALLCONV OP*      Perl_do_readline(pTHX);