In perl.git, the branch blead-next has been updated <http://perl5.git.perl.org/perl.git/commitdiff/a83d8d496b4272a00bcd95889955da7930f3133f?hp=3b0b633b5b0d9d3c864e7902ade8e9780a2c2161>
- Log ----------------------------------------------------------------- commit a83d8d496b4272a00bcd95889955da7930f3133f Author: Dagfinn Ilmari Mannsåker <[email protected]> Date: Tue Jan 17 17:37:56 2017 +0000 Eliminate remaining uses of PL_statbuf Give Perl_nextargv its own statbuf and pass a pointer to it into Perl_do_open_raw and thence S_openn_cleanup when needed. Also reduce the scope of the existing statbuf in Perl_nextargv to make it clear it's distinct from the one populated by do_open_raw. ----------------------------------------------------------------------- Summary of changes: doio.c | 51 ++++++++++++++++++++++++++++----------------------- embed.fnc | 5 +++-- embed.h | 4 ++-- embedvar.h | 1 - intrpvar.h | 1 - pod/perldelta.pod | 2 ++ pp_sys.c | 2 +- proto.h | 4 ++-- sv.c | 1 - 9 files changed, 38 insertions(+), 33 deletions(-) diff --git a/doio.c b/doio.c index becb19b080..6f4cd84f8c 100644 --- a/doio.c +++ b/doio.c @@ -136,14 +136,14 @@ Perl_do_openn(pTHX_ GV *gv, const char *oname, I32 len, int as_raw, Perl_croak(aTHX_ "panic: sysopen with multiple args, num_svs=%ld", (long) num_svs); } - return do_open_raw(gv, oname, len, rawmode, rawperm); + return do_open_raw(gv, oname, len, rawmode, rawperm, NULL); } return do_open6(gv, oname, len, supplied_fp, svp, num_svs); } bool Perl_do_open_raw(pTHX_ GV *gv, const char *oname, STRLEN len, - int rawmode, int rawperm) + int rawmode, int rawperm, Stat_t *statbufp) { PerlIO *saveifp; PerlIO *saveofp; @@ -207,7 +207,7 @@ Perl_do_open_raw(pTHX_ GV *gv, const char *oname, STRLEN len, fp = PerlIO_openn(aTHX_ NULL, mode, -1, rawmode, rawperm, NULL, 1, &namesv); } return openn_cleanup(gv, io, fp, mode, oname, saveifp, saveofp, savefd, - savetype, writing, 0, NULL); + savetype, writing, 0, NULL, statbufp); } bool @@ -606,7 +606,7 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len, say_false: return openn_cleanup(gv, io, fp, mode, oname, saveifp, saveofp, savefd, - savetype, writing, was_fdopen, type); + savetype, writing, was_fdopen, type, NULL); } /* Yes, this is ugly, but it's private, and I don't see a cleaner way to @@ -614,9 +614,10 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len, static bool S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, PerlIO *saveifp, PerlIO *saveofp, int savefd, char savetype, - int writing, bool was_fdopen, const char *type) + int writing, bool was_fdopen, const char *type, Stat_t *statbufp) { int fd; + Stat_t statbuf; PERL_ARGS_ASSERT_OPENN_CLEANUP; @@ -656,17 +657,17 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, * otherwise unless we "know" the type probe for socket-ness. */ if (IoTYPE(io) && IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD && fd >= 0) { - if (PerlLIO_fstat(fd,&PL_statbuf) < 0) { + if (PerlLIO_fstat(fd,&statbuf) < 0) { /* If PerlIO claims to have fd we had better be able to fstat() it. */ (void) PerlIO_close(fp); goto say_false; } #ifndef PERL_MICRO - if (S_ISSOCK(PL_statbuf.st_mode)) + if (S_ISSOCK(statbuf.st_mode)) IoTYPE(io) = IoTYPE_SOCKET; /* in case a socket was passed in to us */ #ifdef HAS_SOCKET else if ( - !(PL_statbuf.st_mode & S_IFMT) + !(statbuf.st_mode & S_IFMT) && IoTYPE(io) != IoTYPE_WRONLY /* Dups of STD* filehandles already have */ && IoTYPE(io) != IoTYPE_RDONLY /* type so they aren't marked as sockets */ ) { /* on OS's that return 0 on fstat()ed pipe */ @@ -787,7 +788,7 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, IoFLAGS(io) &= ~IOf_NOLINE; if (writing) { if (IoTYPE(io) == IoTYPE_SOCKET - || (IoTYPE(io) == IoTYPE_WRONLY && fd >= 0 && S_ISCHR(PL_statbuf.st_mode)) ) { + || (IoTYPE(io) == IoTYPE_WRONLY && fd >= 0 && S_ISCHR(statbuf.st_mode)) ) { char *s = mode; if (*s == IoTYPE_IMPLICIT || *s == IoTYPE_NUMERIC) s++; @@ -800,6 +801,9 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, else IoOFP(io) = fp; } + if (statbufp) + *statbufp = statbuf; + return TRUE; say_false: @@ -844,7 +848,6 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen) if (!GvAV(gv)) return NULL; while (av_tindex(GvAV(gv)) >= 0) { - Stat_t statbuf; STRLEN oldlen; SV *const sv = av_shift(GvAV(gv)); SAVEFREESV(sv); @@ -861,6 +864,7 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen) } } else { + Stat_t statbuf; { IO * const io = GvIOp(PL_argvoutgv); if (io && IoIFP(io) && old_out_name && !io_close(io, PL_argvoutgv, FALSE, FALSE)) { @@ -872,7 +876,7 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen) Both this block and the block above fall through on open failure to the warning code, and then the while loop above tries the next entry. */ - if (do_open_raw(gv, PL_oldname, oldlen, O_RDONLY, 0)) { + if (do_open_raw(gv, PL_oldname, oldlen, O_RDONLY, 0, &statbuf)) { #ifndef FLEXFILENAMES int filedev; int fileino; @@ -887,12 +891,12 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen) return IoIFP(GvIOp(gv)); } #ifndef FLEXFILENAMES - filedev = PL_statbuf.st_dev; - fileino = PL_statbuf.st_ino; + filedev = statbuf.st_dev; + fileino = statbuf.st_ino; #endif - PL_filemode = PL_statbuf.st_mode; - fileuid = PL_statbuf.st_uid; - filegid = PL_statbuf.st_gid; + PL_filemode = statbuf.st_mode; + fileuid = statbuf.st_uid; + filegid = statbuf.st_gid; if (!S_ISREG(PL_filemode)) { Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE), "Can't do inplace edit: %s is not a regular file", @@ -917,9 +921,9 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen) sv_catpv(sv,PL_inplace); } #ifndef FLEXFILENAMES - if ((PerlLIO_stat(SvPVX_const(sv),&PL_statbuf) >= 0 - && PL_statbuf.st_dev == filedev - && PL_statbuf.st_ino == fileino) + if ((PerlLIO_stat(SvPVX_const(sv),&statbuf) >= 0 + && statbuf.st_dev == filedev + && statbuf.st_ino == fileino) #ifdef DJGPP || ((_djstat_fail_bits & _STFAIL_TRUENAME)!=0) #endif @@ -948,7 +952,7 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen) do_close(gv,FALSE); (void)PerlLIO_unlink(SvPVX_const(sv)); (void)PerlLIO_rename(PL_oldname,SvPVX_const(sv)); - do_open_raw(gv, SvPVX_const(sv), SvCUR(sv), O_RDONLY, 0); + do_open_raw(gv, SvPVX_const(sv), SvCUR(sv), O_RDONLY, 0, NULL); #endif /* DOSISH */ #else (void)UNLINK(SvPVX_const(sv)); @@ -983,11 +987,11 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen) if (!Perl_do_open_raw(aTHX_ PL_argvoutgv, SvPVX_const(sv), SvCUR(sv), #ifdef VMS - O_WRONLY|O_CREAT|O_TRUNC, 0 + O_WRONLY|O_CREAT|O_TRUNC, 0, #else - O_WRONLY|O_CREAT|OPEN_EXCL, 0600 + O_WRONLY|O_CREAT|OPEN_EXCL, 0600, #endif - )) { + NULL)) { Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE), "Can't do inplace edit on %s: %s", PL_oldname, Strerror(errno) ); do_close(gv,FALSE); @@ -1019,6 +1023,7 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen) if (ckWARN_d(WARN_INPLACE)) { const int eno = errno; + Stat_t statbuf; if (PerlLIO_stat(PL_oldname, &statbuf) >= 0 && !S_ISREG(statbuf.st_mode)) { Perl_warner(aTHX_ packWARN(WARN_INPLACE), diff --git a/embed.fnc b/embed.fnc index 35b80d9de0..d0c9953273 100644 --- a/embed.fnc +++ b/embed.fnc @@ -466,14 +466,15 @@ s |bool |openn_cleanup |NN GV *gv|NN IO *io|NULLOK PerlIO *fp \ |NN char *mode|NN const char *oname \ |NULLOK PerlIO *saveifp|NULLOK PerlIO *saveofp \ |int savefd|char savetype|int writing \ - |bool was_fdopen|NULLOK const char *type + |bool was_fdopen|NULLOK const char *type \ + |NULLOK Stat_t *statbufp #endif Ap |bool |do_openn |NN GV *gv|NN const char *oname|I32 len \ |int as_raw|int rawmode|int rawperm \ |NULLOK PerlIO *supplied_fp|NULLOK SV **svp \ |I32 num Mp |bool |do_open_raw |NN GV *gv|NN const char *oname|STRLEN len \ - |int rawmode|int rawperm + |int rawmode|int rawperm|NULLOK Stat_t *statbufp Mp |bool |do_open6 |NN GV *gv|NN const char *oname|STRLEN len \ |NULLOK PerlIO *supplied_fp|NULLOK SV **svp \ |U32 num diff --git a/embed.h b/embed.h index 4400d870b2..2fa77c6fda 100644 --- a/embed.h +++ b/embed.h @@ -1246,7 +1246,7 @@ #define do_execfree() Perl_do_execfree(aTHX) #define do_ncmp(a,b) Perl_do_ncmp(aTHX_ a,b) #define do_open6(a,b,c,d,e,f) Perl_do_open6(aTHX_ a,b,c,d,e,f) -#define do_open_raw(a,b,c,d,e) Perl_do_open_raw(aTHX_ a,b,c,d,e) +#define do_open_raw(a,b,c,d,e,f) Perl_do_open_raw(aTHX_ a,b,c,d,e,f) #define do_print(a,b) Perl_do_print(aTHX_ a,b) #define do_readline() Perl_do_readline(aTHX) #define do_seek(a,b,c) Perl_do_seek(aTHX_ a,b,c) @@ -1542,7 +1542,7 @@ # if defined(PERL_IN_DOIO_C) #define exec_failed(a,b,c) S_exec_failed(aTHX_ a,b,c) #define ingroup(a,b) S_ingroup(aTHX_ a,b) -#define openn_cleanup(a,b,c,d,e,f,g,h,i,j,k,l) S_openn_cleanup(aTHX_ a,b,c,d,e,f,g,h,i,j,k,l) +#define openn_cleanup(a,b,c,d,e,f,g,h,i,j,k,l,m) S_openn_cleanup(aTHX_ a,b,c,d,e,f,g,h,i,j,k,l,m) #define openn_setup(a,b,c,d,e,f) S_openn_setup(aTHX_ a,b,c,d,e,f) # endif # if defined(PERL_IN_DOOP_C) diff --git a/embedvar.h b/embedvar.h index a33f213efc..e8cab91e6f 100644 --- a/embedvar.h +++ b/embedvar.h @@ -299,7 +299,6 @@ #define PL_stashpad (vTHX->Istashpad) #define PL_stashpadix (vTHX->Istashpadix) #define PL_stashpadmax (vTHX->Istashpadmax) -#define PL_statbuf (vTHX->Istatbuf) #define PL_statcache (vTHX->Istatcache) #define PL_statgv (vTHX->Istatgv) #define PL_statname (vTHX->Istatname) diff --git a/intrpvar.h b/intrpvar.h index d203855314..c6070eab43 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -188,7 +188,6 @@ PERLVAR(I, na, STRLEN) /* for use in SvPV when length is Not Applicable */ /* stat stuff */ -PERLVAR(I, statbuf, Stat_t) PERLVAR(I, statcache, Stat_t) /* _ */ PERLVAR(I, statgv, GV *) PERLVARI(I, statname, SV *, NULL) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 6d4e1abc43..b3c937753a 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -331,6 +331,8 @@ well. =over 4 +=item The C<PL_statbuf> interpreter variable has been removed. + =item * XXX diff --git a/pp_sys.c b/pp_sys.c index 7a5703515c..98f36453b2 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -1659,7 +1659,7 @@ PP(pp_sysopen) /* Need TIEHANDLE method ? */ const char * const tmps = SvPV_const(sv, len); - if (do_open_raw(gv, tmps, len, mode, perm)) { + if (do_open_raw(gv, tmps, len, mode, perm, NULL)) { IoLINES(GvIOp(gv)) = 0; PUSHs(&PL_sv_yes); } diff --git a/proto.h b/proto.h index 8f64cf614f..8307c6d6a9 100644 --- a/proto.h +++ b/proto.h @@ -773,7 +773,7 @@ PERL_CALLCONV bool Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len, Pe PERL_CALLCONV bool Perl_do_open9(pTHX_ GV *gv, const char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs, I32 num); #define PERL_ARGS_ASSERT_DO_OPEN9 \ assert(gv); assert(name); assert(svs) -PERL_CALLCONV bool Perl_do_open_raw(pTHX_ GV *gv, const char *oname, STRLEN len, int rawmode, int rawperm); +PERL_CALLCONV bool Perl_do_open_raw(pTHX_ GV *gv, const char *oname, STRLEN len, int rawmode, int rawperm, Stat_t *statbufp); #define PERL_ARGS_ASSERT_DO_OPEN_RAW \ assert(gv); assert(oname) PERL_CALLCONV bool Perl_do_openn(pTHX_ GV *gv, const char *oname, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp, I32 num); @@ -4436,7 +4436,7 @@ STATIC void S_exec_failed(pTHX_ const char *cmd, int fd, int do_report); STATIC bool S_ingroup(pTHX_ Gid_t testgid, bool effective) __attribute__warn_unused_result__; -STATIC bool S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, PerlIO *saveifp, PerlIO *saveofp, int savefd, char savetype, int writing, bool was_fdopen, const char *typ ... [3 chars truncated] +STATIC bool S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, PerlIO *saveifp, PerlIO *saveofp, int savefd, char savetype, int writing, bool was_fdopen, const char *typ ... [21 chars truncated] #define PERL_ARGS_ASSERT_OPENN_CLEANUP \ assert(gv); assert(io); assert(mode); assert(oname) STATIC IO * S_openn_setup(pTHX_ GV *gv, char *mode, PerlIO **saveifp, PerlIO **saveofp, int *savefd, char *savetype); diff --git a/sv.c b/sv.c index e90ea8408b..81e6ff6605 100644 --- a/sv.c +++ b/sv.c @@ -15072,7 +15072,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_Xpv = (XPV*)NULL; my_perl->Ina = proto_perl->Ina; - PL_statbuf = proto_perl->Istatbuf; PL_statcache = proto_perl->Istatcache; #ifndef NO_TAINT_SUPPORT -- Perl5 Master Repository
