X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doio.c;h=1135a62750f734bf11c7bcf9784b74cf965241bf;hb=1ae0ae1779f56be3f5008214f23d0e0a7f3dce42;hp=fdd83f6ee553ccabb00549c0ea4ad0699ff2c192;hpb=97828cef4d4cd22b548b8ec430d2e0e28ea8ae8c;p=p5sagit%2Fp5-mst-13.2.git diff --git a/doio.c b/doio.c index fdd83f6..1135a62 100644 --- a/doio.c +++ b/doio.c @@ -1,6 +1,7 @@ /* doio.c * - * Copyright (c) 1991-2002, 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. @@ -323,12 +324,13 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, if (num_svs > 1) { Perl_croak(aTHX_ "More than one argument to '%c&' open",IoTYPE(io)); } + /*SUPPRESS 530*/ + for (; isSPACE(*type); type++) ; if (num_svs && (SvIOK(*svp) || (SvPOK(*svp) && looks_like_number(*svp)))) { fd = SvUV(*svp); + num_svs = 0; } else if (isDIGIT(*type)) { - /*SUPPRESS 530*/ - for (; isSPACE(*type); type++) ; fd = atoi(type); } else { @@ -338,8 +340,6 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, } else { GV *thatgv; - /*SUPPRESS 530*/ - for (; isSPACE(*type); type++) ; thatgv = gv_fetchpv(type,FALSE,SVt_PVIO); thatio = GvIO(thatgv); } @@ -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 @@ -718,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)); @@ -774,8 +784,8 @@ Perl_nextargv(pTHX_ register GV *gv) { if (ckWARN_d(WARN_INPLACE)) Perl_warner(aTHX_ packWARN(WARN_INPLACE), - "Can't do inplace edit: %s would not be unique", - SvPVX(sv)); + "Can't do inplace edit: %"SVf" would not be unique", + sv); do_close(gv,FALSE); continue; } @@ -785,8 +795,8 @@ Perl_nextargv(pTHX_ register GV *gv) if (PerlLIO_rename(PL_oldname,SvPVX(sv)) < 0) { if (ckWARN_d(WARN_INPLACE)) Perl_warner(aTHX_ packWARN(WARN_INPLACE), - "Can't rename %s to %s: %s, skipping file", - PL_oldname, SvPVX(sv), Strerror(errno) ); + "Can't rename %s to %"SVf": %s, skipping file", + PL_oldname, sv, Strerror(errno) ); do_close(gv,FALSE); continue; } @@ -801,8 +811,8 @@ Perl_nextargv(pTHX_ register GV *gv) if (link(PL_oldname,SvPVX(sv)) < 0) { if (ckWARN_d(WARN_INPLACE)) Perl_warner(aTHX_ packWARN(WARN_INPLACE), - "Can't rename %s to %s: %s, skipping file", - PL_oldname, SvPVX(sv), Strerror(errno) ); + "Can't rename %s to %"SVf": %s, skipping file", + PL_oldname, sv, Strerror(errno) ); do_close(gv,FALSE); continue; } @@ -922,8 +932,8 @@ Perl_do_pipe(pTHX_ SV *sv, GV *rgv, GV *wgv) if (PerlProc_pipe(fd) < 0) goto badexit; - IoIFP(rstio) = PerlIO_fdopen(fd[0], "r"); - IoOFP(wstio) = PerlIO_fdopen(fd[1], "w"); + IoIFP(rstio) = PerlIO_fdopen(fd[0], "r"PIPESOCK_MODE); + IoOFP(wstio) = PerlIO_fdopen(fd[1], "w"PIPESOCK_MODE); IoOFP(rstio) = IoIFP(rstio); IoIFP(wstio) = IoOFP(wstio); IoTYPE(rstio) = IoTYPE_RDONLY; @@ -1028,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) @@ -1267,7 +1281,8 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp) default: if (PerlIO_isutf8(fp)) { if (!SvUTF8(sv)) - sv_utf8_upgrade(sv = sv_mortalcopy(sv)); + sv_utf8_upgrade_flags(sv = sv_mortalcopy(sv), + SV_GMAGIC|SV_UTF8_NO_ENCODING); } else if (DO_UTF8(sv)) { if (!sv_utf8_downgrade((sv = sv_mortalcopy(sv)), TRUE) @@ -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')) @@ -1641,10 +1657,10 @@ nothing in the core. if (mark == sp) break; s = SvPVx(*++mark, n_a); - if (isUPPER(*s)) { + if (isALPHA(*s)) { if (*s == 'S' && s[1] == 'I' && s[2] == 'G') s += 3; - if (!(val = whichsig(s))) + if ((val = whichsig(s)) < 0) Perl_croak(aTHX_ "Unrecognized signal name \"%s\"",s); } else @@ -1744,22 +1760,23 @@ nothing in the core. SV* modified = *++mark; void * utbufp = &utbuf; - /* be like C, and if both times are undefined, let the C - library figure out what to do. This usually means - "current time" */ + /* Be like C, and if both times are undefined, let the C + * library figure out what to do. This usually means + * "current time". */ if ( accessed == &PL_sv_undef && modified == &PL_sv_undef ) - utbufp = NULL; - - Zero(&utbuf, sizeof utbuf, char); + utbufp = NULL; + else { + Zero(&utbuf, sizeof utbuf, char); #ifdef BIG_TIME - utbuf.actime = (Time_t)SvNVx(accessed); /* time accessed */ - utbuf.modtime = (Time_t)SvNVx(modified); /* time modified */ + utbuf.actime = (Time_t)SvNVx(accessed); /* time accessed */ + utbuf.modtime = (Time_t)SvNVx(modified); /* time modified */ #else - utbuf.actime = (Time_t)SvIVx(accessed); /* time accessed */ - utbuf.modtime = (Time_t)SvIVx(modified); /* time modified */ + utbuf.actime = (Time_t)SvIVx(accessed); /* time accessed */ + utbuf.modtime = (Time_t)SvIVx(modified); /* time modified */ #endif - APPLY_TAINT_PROPER(); + } + APPLY_TAINT_PROPER(); tot = sp - mark; while (++mark <= sp) { char *name = SvPVx(*mark, n_a);