X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doio.c;h=18d52544597f3d0d8518df4876c65b69b8541a2d;hb=5702da47233114a6ad065f7f23d72aab80bc1f11;hp=091e02b94438a3e916a8c275b7f098a31a13ef1e;hpb=e02bfb16cd9606a5771a9dfe520cab0ea81522e8;p=p5sagit%2Fp5-mst-13.2.git diff --git a/doio.c b/doio.c index 091e02b..18d5254 100644 --- a/doio.c +++ b/doio.c @@ -1,6 +1,7 @@ /* doio.c * - * Copyright (c) 1991-2003, Larry Wall + * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, + * 2000, 2001, 2002, 2003, by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -640,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 @@ -717,6 +726,8 @@ Perl_nextargv(pTHX_ register GV *gv) #endif } PL_filemode = 0; + if (!GvAV(gv)) + return Nullfp; while (av_len(GvAV(gv)) >= 0) { STRLEN oldlen; sv = av_shift(GvAV(gv)); @@ -1027,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) @@ -1321,7 +1336,7 @@ Perl_my_stat(pTHX) else { SV* sv = POPs; char *s; - STRLEN n_a; + STRLEN len; PUTBACK; if (SvTYPE(sv) == SVt_PVGV) { gv = (GV*)sv; @@ -1332,9 +1347,10 @@ Perl_my_stat(pTHX) goto do_fstat; } - s = SvPV(sv, n_a); + s = SvPV(sv, len); PL_statgv = Nullgv; - sv_setpv(PL_statname, s); + sv_setpvn(PL_statname, s, len); + s = SvPVX(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')) @@ -1379,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, @@ -1411,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)); @@ -1484,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; } @@ -1527,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; } } @@ -1545,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;