Consistent spaces after dots in perlintern.pod

[perl5.git] / doio.c

diff --git a/doio.c b/doio.c
index 3988c78..1fbc9a0 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -359,13 +359,6 @@ Perl_do_openn(pTHX_ GV *gv, const char *oname, I32 len, int as_raw,
                             * be optimized away on most platforms;
                             * only Solaris and Linux seem to flush
                             * on that. --jhi */
-#ifdef USE_SFIO
-                           /* sfio fails to clear error on next
-                              sfwrite, contrary to documentation.
-                              -- Nicholas Clark */
-                           if (PerlIO_seek(that_fp, 0, SEEK_CUR) == -1)
-                               PerlIO_clearerr(that_fp);
-#endif
                            /* On the other hand, do all platforms
                             * take gracefully to flushing a read-only
                             * filehandle?  Perhaps we should do
@@ -545,7 +538,11 @@ Perl_do_openn(pTHX_ GV *gv, const char *oname, I32 len, int as_raw,
            && strchr(oname, '\n')
            
        )
+        {
+            GCC_DIAG_IGNORE(-Wformat-nonliteral); /* PL_warn_nl is constant */
            Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
+            GCC_DIAG_RESTORE;
+        }
        goto say_false;
     }
 
@@ -879,13 +876,16 @@ Perl_nextargv(pTHX_ GV *gv)
                (void)PerlLIO_chmod(PL_oldname,PL_filemode);
 #endif
                if (fileuid != PL_statbuf.st_uid || filegid != PL_statbuf.st_gid) {
+                    int rc = 0;
 #ifdef HAS_FCHOWN
-                   (void)fchown(PL_lastfd,fileuid,filegid);
+                   rc = fchown(PL_lastfd,fileuid,filegid);
 #else
 #ifdef HAS_CHOWN
-                   (void)PerlLIO_chown(PL_oldname,fileuid,filegid);
+                   rc = PerlLIO_chown(PL_oldname,fileuid,filegid);
 #endif
 #endif
+                    /* XXX silently ignore failures */
+                    PERL_UNUSED_VAR(rc);
                }
            }
            return IoIFP(GvIOp(gv));
@@ -1052,10 +1052,6 @@ Perl_do_tell(pTHX_ GV *gv)
     PERL_ARGS_ASSERT_DO_TELL;
 
     if (io && (fp = IoIFP(io))) {
-#ifdef ULTRIX_STDIO_BOTCH
-       if (PerlIO_eof(fp))
-           (void)PerlIO_seek(fp, 0L, 2);       /* ultrix 1.2 workaround */
-#endif
        return PerlIO_tell(fp);
     }
     report_evil_fh(gv);
@@ -1071,10 +1067,6 @@ Perl_do_seek(pTHX_ GV *gv, Off_t pos, int whence)
     PerlIO *fp;
 
     if (io && (fp = IoIFP(io))) {
-#ifdef ULTRIX_STDIO_BOTCH
-       if (PerlIO_eof(fp))
-           (void)PerlIO_seek(fp, 0L, 2);       /* ultrix 1.2 workaround */
-#endif
        return PerlIO_seek(fp, pos, whence) >= 0;
     }
     report_evil_fh(gv);
@@ -1329,8 +1321,11 @@ Perl_my_stat_flags(pTHX_ const U32 flags)
        s = SvPVX_const(PL_statname);           /* s now NUL-terminated */
        PL_laststype = OP_STAT;
        PL_laststatval = PerlLIO_stat(s, &PL_statcache);
-       if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(s, '\n'))
+       if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(s, '\n')) {
+            GCC_DIAG_IGNORE(-Wformat-nonliteral); /* PL_warn_nl is constant */
            Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat");
+            GCC_DIAG_RESTORE;
+        }
        return PL_laststatval;
     }
 }
@@ -1389,8 +1384,11 @@ Perl_my_lstat_flags(pTHX_ const U32 flags)
     file = SvPV_flags_const_nolen(sv, flags);
     sv_setpv(PL_statname,file);
     PL_laststatval = PerlLIO_lstat(file,&PL_statcache);
-    if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(file, '\n'))
-       Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "lstat");
+    if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(file, '\n')) {
+        GCC_DIAG_IGNORE(-Wformat-nonliteral); /* PL_warn_nl is constant */
+        Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "lstat");
+        GCC_DIAG_RESTORE;
+    }
     return PL_laststatval;
 }
 
@@ -1403,7 +1401,9 @@ S_exec_failed(pTHX_ const char *cmd, int fd, int do_report)
        Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
                    cmd, Strerror(e));
     if (do_report) {
-       PerlLIO_write(fd, (void*)&e, sizeof(int));
+        int rc = PerlLIO_write(fd, (void*)&e, sizeof(int));
+        /* silently ignore failures */
+        PERL_UNUSED_VAR(rc);
        PerlLIO_close(fd);
     }
 }
@@ -1809,13 +1809,17 @@ nothing in the core.
            if (!IS_SAFE_PATHNAME(s, len, "unlink")) {
                 tot--;
             }
-           else if (PerlProc_geteuid() || PL_unsafe) {
+           else if (PL_unsafe) {
                if (UNLINK(s))
                    tot--;
            }
            else {      /* don't let root wipe out directories without -U */
-               if (PerlLIO_lstat(s,&PL_statbuf) < 0 || S_ISDIR(PL_statbuf.st_mode))
+               if (PerlLIO_lstat(s,&PL_statbuf) < 0)
                    tot--;
+               else if (S_ISDIR(PL_statbuf.st_mode)) {
+                   tot--;
+                   SETERRNO(EISDIR, SS$_NOPRIV);
+               }
                else {
                    if (UNLINK(s))
                        tot--;
@@ -2144,11 +2148,16 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp)
 #ifdef Semctl
             union semun unsemds;
 
+            if(cmd == SETVAL) {
+                unsemds.val = PTR2nat(a);
+            }
+            else {
 #ifdef EXTRA_F_IN_SEMUN_BUF
-            unsemds.buff = (struct semid_ds *)a;
+                unsemds.buff = (struct semid_ds *)a;
 #else
-            unsemds.buf = (struct semid_ds *)a;
+                unsemds.buf = (struct semid_ds *)a;
 #endif
+            }
            ret = Semctl(id, n, cmd, unsemds);
 #else
            /* diag_listed_as: sem%s not implemented */
@@ -2227,10 +2236,8 @@ Perl_do_msgrcv(pTHX_ SV **mark, SV **sp)
     if (ret >= 0) {
        SvCUR_set(mstr, sizeof(long)+ret);
        *SvEND(mstr) = '\0';
-#ifndef INCOMPLETE_TAINTS
        /* who knows who has been playing with this message? */
        SvTAINTED_on(mstr);
-#endif
     }
     return ret;
 #else
@@ -2279,15 +2286,6 @@ Perl_do_semop(pTHX_ SV **mark, SV **sp)
             t++;
         }
         result = semop(id, temps, nsops);
-        t = temps;
-        o = ops;
-        i = nsops;
-        while (i--) {
-            *o++ = t->sem_num;
-            *o++ = t->sem_op;
-            *o++ = t->sem_flg;
-            t++;
-        }
         Safefree(temps);
         return result;
     }
@@ -2337,10 +2335,8 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
        SvCUR_set(mstr, msize);
        *SvEND(mstr) = '\0';
        SvSETMAGIC(mstr);
-#ifndef INCOMPLETE_TAINTS
        /* who knows who has been playing with this shared memory? */
        SvTAINTED_on(mstr);
-#endif
     }
     else {
        STRLEN len;
@@ -2367,7 +2363,7 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
 =for apidoc start_glob
 
 Function called by C<do_readline> to spawn a glob (or do the glob inside
-perl on VMS). This code used to be inline, but now perl uses C<File::Glob>
+perl on VMS).  This code used to be inline, but now perl uses C<File::Glob>
 this glob starter is only used by miniperl during the build process.
 Moving it away shrinks pp_hot.c; shrinking pp_hot.c helps speed perl up.
 
@@ -2425,11 +2421,7 @@ Perl_vms_start_glob
 #else
     sv_setpv(tmpcmd, "echo ");
     sv_catsv(tmpcmd, tmpglob);
-#if 'z' - 'a' == 25
-    sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
-#else
     sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\n\\n\\n\\n'|");
-#endif
 #endif /* !CSH */
 #endif /* !DOSISH */
     {
@@ -2447,6 +2439,12 @@ Perl_vms_start_glob
     fp = IoIFP(io);
 #endif /* !VMS */
     LEAVE;
+
+    if (!fp && ckWARN(WARN_GLOB)) {
+        Perl_warner(aTHX_ packWARN(WARN_GLOB), "glob failed (can't start child: %s)",
+                    Strerror(errno));
+    }
+
     return fp;
 }