A bug introduced in #8217 (the undefined variable in the

[p5sagit/p5-mst-13.2.git] / doio.c

diff --git a/doio.c b/doio.c
index 1ac381b..6056ea7 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1,6 +1,6 @@
 /*    doio.c
  *
- *    Copyright (c) 1991-2000, Larry Wall
+ *    Copyright (c) 1991-2001, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -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 */
@@ -476,6 +486,15 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
            SV *sv;
 
            PerlLIO_dup2(PerlIO_fileno(fp), fd);
+#ifdef VMS
+           if (fd != PerlIO_fileno(PerlIO_stdin())) {
+             char newname[FILENAME_MAX+1];
+             if (fgetname(fp, newname)) {
+               if (fd == PerlIO_fileno(PerlIO_stdout())) Perl_vmssetuserlnm("SYS$OUTPUT", newname);
+               if (fd == PerlIO_fileno(PerlIO_stderr())) Perl_vmssetuserlnm("SYS$ERROR",  newname);
+             }
+           }
+#endif
            LOCK_FDPID_MUTEX;
            sv = *av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE);
            (void)SvUPGRADE(sv, SVt_IV);
@@ -520,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;
           }