* 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
&& 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;
}
(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));
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;
}
}
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;
}
Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
cmd, Strerror(e));
if (do_report) {
- (void)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);
}
}
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--;
#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 */
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;
}
=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.
#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 */
{