X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/07bd88da0f6c75e74e6c72ad5849aad6daaff68d..e8432c63fd530dd325a1bd86b17c892b4cfb754a:/doio.c diff --git a/doio.c b/doio.c index ecfe3db..d8ea076 100644 --- a/doio.c +++ b/doio.c @@ -741,9 +741,10 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, int ofd = PerlIO_fileno(fp); int dupfd = ofd >= 0 ? PerlLIO_dup(ofd) : -1; #if defined(HAS_FCNTL) && defined(F_SETFD) - /* Assume if we have F_SETFD we have F_GETFD */ - int coe = ofd >= 0 ? fcntl(ofd, F_GETFD) : -1; - if (coe < 0) { + /* Assume if we have F_SETFD we have F_GETFD. */ + /* Get a copy of all the fd flags. */ + int fd_flags = ofd >= 0 ? fcntl(ofd, F_GETFD) : -1; + if (fd_flags < 0) { if (dupfd >= 0) PerlLIO_close(dupfd); goto say_false; @@ -757,8 +758,9 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, PerlIO_close(fp); PerlLIO_dup2(dupfd, ofd); #if defined(HAS_FCNTL) && defined(F_SETFD) - /* The dup trick has lost close-on-exec on ofd */ - fcntl(ofd,F_SETFD, coe); + /* The dup trick has lost close-on-exec on ofd, + * and possibly any other flags, so restore them. */ + fcntl(ofd,F_SETFD, fd_flags); #endif PerlLIO_close(dupfd); } @@ -769,12 +771,10 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, PerlIO_clearerr(fp); fd = PerlIO_fileno(fp); } -#if defined(HAS_FCNTL) && defined(F_SETFD) - if (fd >= 0) { - if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0) { - PerlLIO_close(fd); - goto say_false; - } +#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC) + if (fd > PL_maxsysfd && fcntl(fd, F_SETFD, FD_CLOEXEC) < 0) { + PerlLIO_close(fd); + goto say_false; } #endif IoIFP(io) = fp; @@ -1528,9 +1528,14 @@ S_exec_failed(pTHX_ const char *cmd, int fd, int do_report) { const int e = errno; PERL_ARGS_ASSERT_EXEC_FAILED; - if (ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s", - cmd, Strerror(e)); +#ifdef __amigaos4__ + if (e) +#endif + { + if (ckWARN(WARN_EXEC)) + Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s", + cmd, Strerror(e)); + } if (do_report) { /* XXX silently ignore failures */ PERL_UNUSED_RESULT(PerlLIO_write(fd, (void*)&e, sizeof(int))); @@ -1538,12 +1543,14 @@ S_exec_failed(pTHX_ const char *cmd, int fd, int do_report) } } -bool +DO_EXEC_TYPE Perl_do_aexec5(pTHX_ SV *really, SV **mark, SV **sp, int fd, int do_report) { dVAR; + DO_EXEC_TYPE result = DO_EXEC_FAILURE; PERL_ARGS_ASSERT_DO_AEXEC5; + PERL_UNUSED_VAR(result); /* if DO_EXEC_TYPE is bool */ #if defined(__SYMBIAN32__) || defined(__LIBCATAMOUNT__) Perl_croak(aTHX_ "exec? I'm not *that* kind of operating system"); #else @@ -1566,16 +1573,21 @@ Perl_do_aexec5(pTHX_ SV *really, SV **mark, SV **sp, (really && *tmps != '/')) /* will execvp use PATH? */ TAINT_ENV(); /* testing IFS here is overkill, probably */ PERL_FPU_PRE_EXEC - if (really && *tmps) - PerlProc_execvp(tmps,EXEC_ARGV_CAST(PL_Argv)); - else - PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv)); + if (really && *tmps) { + result = + (DO_EXEC_TYPE) + PerlProc_execvp(tmps,EXEC_ARGV_CAST(PL_Argv)); + } else { + result = + (DO_EXEC_TYPE) + PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv)); + } PERL_FPU_POST_EXEC S_exec_failed(aTHX_ (really ? tmps : PL_Argv[0]), fd, do_report); } do_execfree(); #endif - return FALSE; + return DO_EXEC_RETVAL(result); } void @@ -1589,7 +1601,7 @@ Perl_do_execfree(pTHX) #ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION -bool +DO_EXEC_TYPE Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) { dVAR; @@ -1599,6 +1611,8 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) char *cmd; /* Make a copy so we can change it */ const Size_t cmdlen = strlen(incmd) + 1; + DO_EXEC_TYPE result = DO_EXEC_FAILURE; + PERL_UNUSED_VAR(result); /* if DO_EXEC_TYPE is bool */ PERL_ARGS_ASSERT_DO_EXEC3; @@ -1634,12 +1648,14 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) if (s[-1] == '\'') { *--s = '\0'; PERL_FPU_PRE_EXEC - PerlProc_execl(PL_cshname, "csh", flags, ncmd, (char*)NULL); + result = + (DO_EXEC_TYPE) + PerlProc_execl(PL_cshname, "csh", flags, ncmd, (char*)NULL); PERL_FPU_POST_EXEC *s = '\''; S_exec_failed(aTHX_ PL_cshname, fd, do_report); Safefree(buf); - return FALSE; + return DO_EXEC_RETVAL(result); } } } @@ -1683,11 +1699,16 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) } doshell: PERL_FPU_PRE_EXEC - PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char *)NULL); + result = + (DO_EXEC_TYPE) + PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char *)NULL); PERL_FPU_POST_EXEC S_exec_failed(aTHX_ PL_sh_path, fd, do_report); +#if defined (__amigaos4__) + amigaos_post_exec(fd, do_report); +#endif Safefree(buf); - return FALSE; + return DO_EXEC_RETVAL(result); } } @@ -1707,7 +1728,9 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) *a = NULL; if (PL_Argv[0]) { PERL_FPU_PRE_EXEC - PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv)); + result = + (DO_EXEC_TYPE) + PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv)); PERL_FPU_POST_EXEC if (errno == ENOEXEC) { /* for system V NIH syndrome */ do_execfree(); @@ -1717,7 +1740,7 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) } do_execfree(); Safefree(buf); - return FALSE; + return DO_EXEC_RETVAL(result); } #endif /* OS2 || WIN32 */ @@ -2522,7 +2545,7 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp) Function called by C to spawn a glob (or do the glob inside perl on VMS). This code used to be inline, but now perl uses C 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. +Moving it away shrinks F; shrinking F helps speed perl up. =cut */