This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
add note about map in scalar context
[perl5.git] / doio.c
diff --git a/doio.c b/doio.c
index 0cdf87d..695a209 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1,6 +1,6 @@
 /*    doio.c
  *
- *    Copyright (c) 1991-1997, Larry Wall
+ *    Copyright (c) 1991-1999, 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.
 #include "perl.h"
 
 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
+#ifndef HAS_SEM
 #include <sys/ipc.h>
+#endif
 #ifdef HAS_MSG
 #include <sys/msg.h>
 #endif
-#ifdef HAS_SEM
-#include <sys/sem.h>
-#endif
 #ifdef HAS_SHM
 #include <sys/shm.h>
 # ifndef HAS_SHMAT_PROTOTYPE
@@ -188,6 +187,13 @@ do_open(GV *gv, register char *name, I32 len, int as_raw, int rawmode, int rawpe
        if (*name == '|') {
            /*SUPPRESS 530*/
            for (name++; isSPACE(*name); name++) ;
+           if (*name == '\0') { /* command is missing 19990114 */
+               dTHR;
+               if (ckWARN(WARN_PIPE))
+                   warner(WARN_PIPE, "Missing command in piped open");
+               errno = EPIPE;
+               goto say_false;
+           }
            if (strNE(name,"-"))
                TAINT_ENV();
            TAINT_PROPER("piped open");
@@ -285,6 +291,13 @@ do_open(GV *gv, register char *name, I32 len, int as_raw, int rawmode, int rawpe
                name[--len] = '\0';
            /*SUPPRESS 530*/
            for (; isSPACE(*name); name++) ;
+           if (*name == '\0') { /* command is missing 19990114 */
+               dTHR;
+               if (ckWARN(WARN_PIPE))
+                   warner(WARN_PIPE, "Missing command in piped open");
+               errno = EPIPE;
+               goto say_false;
+           }
            if (strNE(name,"-"))
                TAINT_ENV();
            TAINT_PROPER("piped open");
@@ -366,8 +379,12 @@ do_open(GV *gv, register char *name, I32 len, int as_raw, int rawmode, int rawpe
        PerlIO_clearerr(fp);
     }
 #if defined(HAS_FCNTL) && defined(F_SETFD)
-    fd = PerlIO_fileno(fp);
-    fcntl(fd,F_SETFD,fd > PL_maxsysfd);
+    {
+       int save_errno = errno;
+       fd = PerlIO_fileno(fp);
+       fcntl(fd,F_SETFD,fd > PL_maxsysfd); /* can change errno */
+       errno = save_errno;
+    }
 #endif
     IoIFP(io) = fp;
     if (writing) {
@@ -466,7 +483,7 @@ nextargv(register GV *gv)
                       || (_djstat_fail_bits & _STFAIL_TRUENAME)!=0
 #endif
                       ) {
-                       warn("Can't do inplace edit: %s would not be uniq",
+                       warn("Can't do inplace edit: %s would not be unique",
                          SvPVX(sv) );
                        do_close(gv,FALSE);
                        continue;
@@ -552,7 +569,7 @@ nextargv(register GV *gv)
        }
        else
            PerlIO_printf(PerlIO_stderr(), "Can't open %s: %s\n",
-             SvPV(sv, PL_na), Strerror(errno));
+             SvPV(sv, oldlen), Strerror(errno));
     }
     if (PL_inplace) {
        (void)do_close(PL_argvoutgv,FALSE);
@@ -777,7 +794,7 @@ do_binmode(PerlIO *fp, int iotype, int flag)
     if (flag != TRUE)
        croak("panic: unsetting binmode"); /* Not implemented yet */
 #ifdef DOSISH
-#ifdef atarist
+#if defined(atarist) || defined(__MINT__)
     if (!PerlIO_flush(fp) && (fp->_flag |= _IOBIN))
        return 1;
     else
@@ -941,6 +958,7 @@ my_stat(ARGSproto)
     else {
        SV* sv = POPs;
        char *s;
+       STRLEN n_a;
        PUTBACK;
        if (SvTYPE(sv) == SVt_PVGV) {
            tmpgv = (GV*)sv;
@@ -951,7 +969,7 @@ my_stat(ARGSproto)
            goto do_fstat;
        }
 
-       s = SvPV(sv, PL_na);
+       s = SvPV(sv, n_a);
        PL_statgv = Nullgv;
        sv_setpv(PL_statname, s);
        PL_laststype = OP_STAT;
@@ -967,6 +985,7 @@ my_lstat(ARGSproto)
 {
     djSP;
     SV *sv;
+    STRLEN n_a;
     if (PL_op->op_flags & OPf_REF) {
        EXTEND(SP,1);
        if (cGVOP->op_gv == PL_defgv) {
@@ -981,13 +1000,13 @@ my_lstat(ARGSproto)
     PL_statgv = Nullgv;
     sv = POPs;
     PUTBACK;
-    sv_setpv(PL_statname,SvPV(sv, PL_na));
+    sv_setpv(PL_statname,SvPV(sv, n_a));
 #ifdef HAS_LSTAT
-    PL_laststatval = PerlLIO_lstat(SvPV(sv, PL_na),&PL_statcache);
+    PL_laststatval = PerlLIO_lstat(SvPV(sv, n_a),&PL_statcache);
 #else
-    PL_laststatval = PerlLIO_stat(SvPV(sv, PL_na),&PL_statcache);
+    PL_laststatval = PerlLIO_stat(SvPV(sv, n_a),&PL_statcache);
 #endif
-    if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, PL_na), '\n'))
+    if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, n_a), '\n'))
        warner(WARN_NEWLINE, PL_warn_nl, "lstat");
     return PL_laststatval;
 }
@@ -997,6 +1016,7 @@ do_aexec(SV *really, register SV **mark, register SV **sp)
 {
     register char **a;
     char *tmps;
+    STRLEN n_a;
 
     if (sp > mark) {
        dTHR;
@@ -1004,14 +1024,14 @@ do_aexec(SV *really, register SV **mark, register SV **sp)
        a = PL_Argv;
        while (++mark <= sp) {
            if (*mark)
-               *a++ = SvPVx(*mark, PL_na);
+               *a++ = SvPVx(*mark, n_a);
            else
                *a++ = "";
        }
        *a = Nullch;
        if (*PL_Argv[0] != '/') /* will execvp use PATH? */
            TAINT_ENV();                /* testing IFS here is overkill, probably */
-       if (really && *(tmps = SvPV(really, PL_na)))
+       if (really && *(tmps = SvPV(really, n_a)))
            PerlProc_execvp(tmps,PL_Argv);
        else
            PerlProc_execvp(PL_Argv[0],PL_Argv);
@@ -1142,10 +1162,11 @@ apply(I32 type, register SV **mark, register SV **sp)
     char *what;
     char *s;
     SV **oldmark = mark;
+    STRLEN n_a;
 
 #define APPLY_TAINT_PROPER() \
     STMT_START {                                                       \
-       if (PL_tainting && PL_tainted) { goto taint_proper_label; }     \
+       if (PL_tainted) { TAINT_PROPER(what); }                         \
     } STMT_END
 
     /* This is a first heuristic; it doesn't catch tainting magic. */
@@ -1167,7 +1188,7 @@ apply(I32 type, register SV **mark, register SV **sp)
            APPLY_TAINT_PROPER();
            tot = sp - mark;
            while (++mark <= sp) {
-               char *name = SvPVx(*mark, PL_na);
+               char *name = SvPVx(*mark, n_a);
                APPLY_TAINT_PROPER();
                if (PerlLIO_chmod(name, val))
                    tot--;
@@ -1184,7 +1205,7 @@ apply(I32 type, register SV **mark, register SV **sp)
            APPLY_TAINT_PROPER();
            tot = sp - mark;
            while (++mark <= sp) {
-               char *name = SvPVx(*mark, PL_na);
+               char *name = SvPVx(*mark, n_a);
                APPLY_TAINT_PROPER();
                if (PerlLIO_chown(name, val, val2))
                    tot--;
@@ -1204,7 +1225,7 @@ nothing in the core.
        APPLY_TAINT_PROPER();
        if (mark == sp)
            break;
-       s = SvPVx(*++mark, PL_na);
+       s = SvPVx(*++mark, n_a);
        if (isUPPER(*s)) {
            if (*s == 'S' && s[1] == 'I' && s[2] == 'G')
                s += 3;
@@ -1274,7 +1295,7 @@ nothing in the core.
        APPLY_TAINT_PROPER();
        tot = sp - mark;
        while (++mark <= sp) {
-           s = SvPVx(*mark, PL_na);
+           s = SvPVx(*mark, n_a);
            APPLY_TAINT_PROPER();
            if (PL_euid || PL_unsafe) {
                if (UNLINK(s))
@@ -1303,23 +1324,23 @@ nothing in the core.
            struct utimbuf utbuf;
 #else
            struct {
-               long    actime;
-               long    modtime;
+               Time_t  actime;
+               Time_t  modtime;
            } utbuf;
 #endif
 
            Zero(&utbuf, sizeof utbuf, char);
 #ifdef BIG_TIME
-           utbuf.actime = (Time_t)SvNVx(*++mark);    /* time accessed */
-           utbuf.modtime = (Time_t)SvNVx(*++mark);    /* time modified */
+           utbuf.actime = (Time_t)SvNVx(*++mark);      /* time accessed */
+           utbuf.modtime = (Time_t)SvNVx(*++mark);     /* time modified */
 #else
-           utbuf.actime = SvIVx(*++mark);    /* time accessed */
-           utbuf.modtime = SvIVx(*++mark);    /* time modified */
+           utbuf.actime = (Time_t)SvIVx(*++mark);      /* time accessed */
+           utbuf.modtime = (Time_t)SvIVx(*++mark);     /* time modified */
 #endif
            APPLY_TAINT_PROPER();
            tot = sp - mark;
            while (++mark <= sp) {
-               char *name = SvPVx(*mark, PL_na);
+               char *name = SvPVx(*mark, n_a);
                APPLY_TAINT_PROPER();
                if (PerlLIO_utime(name, &utbuf))
                    tot--;
@@ -1332,10 +1353,6 @@ nothing in the core.
     }
     return tot;
 
-  taint_proper_label:
-    TAINT_PROPER(what);
-    return 0;  /* this should never happen */
-
 #undef APPLY_TAINT_PROPER
 }