CopFILEGV(&PL_compiling) must be reset properly (from Doug MacEachern)

[perl5.git] / doio.c

diff --git a/doio.c b/doio.c
index 4a255b2..3cd199b 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1,6 +1,6 @@
 /*    doio.c
  *
- *    Copyright (c) 1991-1999, Larry Wall
+ *    Copyright (c) 1991-2000, 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.
@@ -41,12 +41,6 @@
 #  endif
 #endif
 
-#ifdef I_FCNTL
-#include <fcntl.h>
-#endif
-#ifdef I_SYS_FILE
-#include <sys/file.h>
-#endif
 #ifdef O_EXCL
 #  define OPEN_EXCL O_EXCL
 #else
@@ -77,15 +71,6 @@
 # endif
 #endif
 
-/* Put this after #includes because <unistd.h> defines _XOPEN_*. */
-#ifndef Sock_size_t
-#  if _XOPEN_VERSION >= 5 || defined(_XOPEN_SOURCE_EXTENDED) || defined(__GLIBC__)
-#    define Sock_size_t Size_t
-#  else
-#    define Sock_size_t int
-#  endif
-#endif
-
 bool
 Perl_do_open(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
             int rawmode, int rawperm, PerlIO *supplied_fp)
@@ -183,28 +168,29 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
        }
     }
     else {
-       char *myname;
-       char *type = name;
-       char *otype = name;
+       char *type;
+       char *oname = name;
        STRLEN tlen;
-       STRLEN otlen = len;
+       STRLEN olen = len;
        char mode[3];           /* stdio file mode ("r\0" or "r+\0") */
        int dodup;
 
+       type = savepvn(name, len);
+       tlen = len;
+       SAVEFREEPV(type);
        if (num_svs) {
-           type = name;
-           name = SvPV(svs, tlen) ;
-           len = (I32)tlen;
+           STRLEN l;
+           name = SvPV(svs, l) ;
+           len = (I32)l;
+           name = savepvn(name, len);
+           SAVEFREEPV(name);
        }
-
-       tlen = otlen;
-       myname = savepvn(name, len);
-       SAVEFREEPV(myname);
-       name = myname;
-       if (!num_svs)
+       else {
            while (tlen && isSPACE(type[tlen-1]))
                type[--tlen] = '\0';
-
+           name = type;
+           len = tlen;
+       }
        mode[0] = mode[1] = mode[2] = '\0';
        IoTYPE(io) = *type;
        if (*type == '+' && tlen > 1 && type[tlen-1] != '|') { /* scary */
@@ -216,12 +202,14 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
        if (*type == '|') {
            if (num_svs && (tlen != 2 || type[1] != '-')) {
              unknown_desr:
-               Perl_croak(aTHX_ "Unknown open() mode '%.*s'", otlen, otype);
+               Perl_croak(aTHX_ "Unknown open() mode '%.*s'", (int)olen, oname);
            }
            /*SUPPRESS 530*/
-           for (type++; isSPACE(*type); type++) ;
-           if (!num_svs)
+           for (type++, tlen--; isSPACE(*type); type++, tlen--) ;
+           if (!num_svs) {
                name = type;
+               len = tlen;
+           }
            if (*name == '\0') { /* command is missing 19990114 */
                dTHR;
                if (ckWARN(WARN_PIPE))
@@ -232,11 +220,11 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
            if (strNE(name,"-") || num_svs)
                TAINT_ENV();
            TAINT_PROPER("piped open");
-           if (name[strlen(name)-1] == '|') {
+           if (name[len-1] == '|') {
                dTHR;
-               name[strlen(name)-1] = '\0' ;
+               name[--len] = '\0' ;
                if (ckWARN(WARN_PIPE))
-                   Perl_warner(aTHX_ WARN_PIPE, "Can't do bidirectional pipe");
+                   Perl_warner(aTHX_ WARN_PIPE, "Can't open bidirectional pipe");
            }
            fp = PerlProc_popen(name,"w");
            writing = 1;
@@ -308,7 +296,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                    if (!(fp = PerlIO_fdopen(fd,mode))) {
                        if (dodup)
                            PerlLIO_close(fd);
-                       }
+                   }
                }
            }
            else {
@@ -452,6 +440,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
     }
 #endif
     IoIFP(io) = fp;
+    IoFLAGS(io) &= ~IOf_NOLINE;
     if (writing) {
        dTHR;
        if (IoTYPE(io) == 's'
@@ -569,7 +558,7 @@ Perl_nextargv(pTHX_ register GV *gv)
                    }
 #endif
 #ifdef HAS_RENAME
-#if !defined(DOSISH) && !defined(CYGWIN)
+#if !defined(DOSISH) && !defined(__CYGWIN__)
                    if (PerlLIO_rename(PL_oldname,SvPVX(sv)) < 0) {
                        if (ckWARN_d(WARN_INPLACE))     
                            Perl_warner(aTHX_ WARN_INPLACE, 
@@ -657,13 +646,17 @@ Perl_nextargv(pTHX_ register GV *gv)
        else {
            dTHR;
            if (ckWARN_d(WARN_INPLACE)) {
-               if (!S_ISREG(PL_statbuf.st_mode))       
+               int eno = errno;
+               if (PerlLIO_stat(PL_oldname, &PL_statbuf) >= 0
+                   && !S_ISREG(PL_statbuf.st_mode))    
+               {
                    Perl_warner(aTHX_ WARN_INPLACE,
                                "Can't do inplace edit: %s is not a regular file",
-                               PL_oldname );
+                               PL_oldname);
+               }
                else
-                   Perl_warner(aTHX_ WARN_INPLACE, "Can't open %s: %s\n",
-                               PL_oldname, Strerror(errno));
+                   Perl_warner(aTHX_ WARN_INPLACE, "Can't open %s: %s",
+                               PL_oldname, Strerror(eno));
            }
        }
     }
@@ -1026,7 +1019,7 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
        {
            dTHR;
            if (ckWARN(WARN_UNINITIALIZED))
-               Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+               report_uninit();
        }
        return TRUE;
     case SVt_IV:
@@ -1064,7 +1057,7 @@ Perl_my_stat(pTHX)
 
     if (PL_op->op_flags & OPf_REF) {
        EXTEND(SP,1);
-       tmpgv = cGVOP;
+       tmpgv = cGVOP_gv;
       do_fstat:
        io = GvIO(tmpgv);
        if (io && IoIFP(io)) {
@@ -1117,7 +1110,7 @@ Perl_my_lstat(pTHX)
     STRLEN n_a;
     if (PL_op->op_flags & OPf_REF) {
        EXTEND(SP,1);
-       if (cGVOP == PL_defgv) {
+       if (cGVOP_gv == PL_defgv) {
            if (PL_laststype != OP_LSTAT)
                Perl_croak(aTHX_ "The stat preceding -l _ wasn't an lstat");
            return PL_laststatval;
@@ -1253,7 +1246,7 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
     if (strnEQ(cmd,"exec",4) && isSPACE(cmd[4]))
        goto doshell;
 
-    for (s = cmd; *s && isALPHA(*s); s++) ;    /* catch VAR=val gizmo */
+    for (s = cmd; *s && isALNUM(*s); s++) ;    /* catch VAR=val gizmo */
     if (*s == '=')
        goto doshell;
 
@@ -1860,6 +1853,9 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
     if (shm == (char *)-1)     /* I hate System V IPC, I really do */
        return -1;
     if (optype == OP_SHMREAD) {
+       /* suppress warning when reading into undef var (tchrist 3/Mar/00) */
+       if (! SvOK(mstr))
+           sv_setpvn(mstr, "", 0);
        SvPV_force(mstr, len);
        mbuf = SvGROW(mstr, msize+1);