X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doio.c;h=18d52544597f3d0d8518df4876c65b69b8541a2d;hb=75bd9dfbf22928c0bf91959743abfe7e4e445490;hp=438139f6e5e68b77edb068ba09c55c932c879231;hpb=4bb101f2758f169969171dfe6b70f68a406dcc1e;p=p5sagit%2Fp5-mst-13.2.git diff --git a/doio.c b/doio.c index 438139f..18d5254 100644 --- a/doio.c +++ b/doio.c @@ -641,8 +641,16 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, /* need to close fp without closing underlying fd */ int ofd = PerlIO_fileno(fp); int dupfd = PerlLIO_dup(ofd); +#if defined(HAS_FCNTL) && defined(F_SETFD) + /* Assume if we have F_SETFD we have F_GETFD */ + int coe = fcntl(ofd,F_GETFD); +#endif 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); +#endif PerlLIO_close(dupfd); } else @@ -1030,17 +1038,21 @@ Perl_do_eof(pTHX_ GV *gv) report_evil_fh(gv, io, OP_phoney_OUTPUT_ONLY); while (IoIFP(io)) { + int saverrno; if (PerlIO_has_cntptr(IoIFP(io))) { /* (the code works without this) */ if (PerlIO_get_cnt(IoIFP(io)) > 0) /* cheat a little, since */ return FALSE; /* this is the most usual case */ } + saverrno = errno; /* getc and ungetc can stomp on errno */ ch = PerlIO_getc(IoIFP(io)); if (ch != EOF) { (void)PerlIO_ungetc(IoIFP(io),ch); + errno = saverrno; return FALSE; } + errno = saverrno; if (PerlIO_has_cntptr(IoIFP(io)) && PerlIO_canset_cnt(IoIFP(io))) { if (PerlIO_get_cnt(IoIFP(io)) < -1) @@ -1383,11 +1395,13 @@ Perl_my_lstat(pTHX) return PL_laststatval; } +#ifndef OS2 bool Perl_do_aexec(pTHX_ SV *really, register SV **mark, register SV **sp) { return do_aexec5(really, mark, sp, 0, 0); } +#endif bool Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp, @@ -1415,10 +1429,12 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp, if ((!really && *PL_Argv[0] != '/') || (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)); + PERL_FPU_POST_EXEC if (ckWARN(WARN_EXEC)) Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s", (really ? tmps : PL_Argv[0]), Strerror(errno)); @@ -1488,7 +1504,9 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report) *--s = '\0'; if (s[-1] == '\'') { *--s = '\0'; + PERL_FPU_PRE_EXEC PerlProc_execl(PL_cshname,"csh", flags, ncmd, (char*)0); + PERL_FPU_POST_EXEC *s = '\''; return FALSE; } @@ -1531,7 +1549,9 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report) } } doshell: + PERL_FPU_PRE_EXEC PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char*)0); + PERL_FPU_POST_EXEC return FALSE; } } @@ -1549,7 +1569,9 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report) } *a = Nullch; if (PL_Argv[0]) { + PERL_FPU_PRE_EXEC PerlProc_execvp(PL_Argv[0],PL_Argv); + PERL_FPU_POST_EXEC if (errno == ENOEXEC) { /* for system V NIH syndrome */ do_execfree(); goto doshell;