if (result == EOF && old_fd > PL_maxsysfd) {
/* Why is this not Perl_warn*() call ? */
PerlIO_printf(Perl_error_log,
- "Warning: unable to close filehandle %"HEKf" properly.\n",
+ "Warning: unable to close filehandle %" HEKf
+ " properly.\n",
HEKfARG(GvENAME_HEK(gv))
);
}
if ((IoTYPE(io) == IoTYPE_RDONLY) &&
(fp == PerlIO_stdout() || fp == PerlIO_stderr())) {
Perl_warner(aTHX_ packWARN(WARN_IO),
- "Filehandle STD%s reopened as %"HEKf
+ "Filehandle STD%s reopened as %" HEKf
" only for input",
((fp == PerlIO_stdout()) ? "OUT" : "ERR"),
HEKfARG(GvENAME_HEK(gv)));
}
else if ((IoTYPE(io) == IoTYPE_WRONLY) && fp == PerlIO_stdin()) {
Perl_warner(aTHX_ packWARN(WARN_IO),
- "Filehandle STDIN reopened as %"HEKf" only for output",
+ "Filehandle STDIN reopened as %" HEKf " only for output",
HEKfARG(GvENAME_HEK(gv))
);
}
fd = PerlIO_fileno(fp);
}
#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
- if (fd > PL_maxsysfd && fcntl(fd, F_SETFD, FD_CLOEXEC) < 0) {
+ if (fd >= 0 && fd > PL_maxsysfd && fcntl(fd, F_SETFD, FD_CLOEXEC) < 0) {
PerlLIO_close(fd);
goto say_false;
}
Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
{
IO * const io = GvIOp(gv);
+ SV *const old_out_name = PL_inplace ? newSVsv(GvSV(gv)) : NULL;
PERL_ARGS_ASSERT_NEXTARGV;
+ if (old_out_name)
+ SAVEFREESV(old_out_name);
+
if (!PL_argvoutgv)
PL_argvoutgv = gv_fetchpvs("ARGVOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
if (io && (IoFLAGS(io) & (IOf_ARGV|IOf_START)) == (IOf_ARGV|IOf_START)) {
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);
}
}
else {
+ {
+ IO * const io = GvIOp(PL_argvoutgv);
+ if (io && IoIFP(io) && old_out_name && !io_close(io, PL_argvoutgv, FALSE, FALSE)) {
+ Perl_croak(aTHX_ "Failed to close in-place edit file %"
+ SVf ": %s\n", old_out_name, Strerror(errno));
+ }
+ }
/* This very long block ends with return IoIFP(GvIOp(gv));
Both this block and the block above fall through on open
failure to the warning code, and then the while loop above tries
const char *star = strchr(PL_inplace, '*');
if (star) {
const char *begin = PL_inplace;
- sv_setpvs(sv, "");
+ SvPVCLEAR(sv);
do {
sv_catpvn(sv, begin, star - begin);
sv_catpvn(sv, PL_oldname, oldlen);
)
{
Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE),
- "Can't do inplace edit: %"SVf" would not be unique",
+ "Can't do inplace edit: %"
+ SVf " would not be unique",
SVfARG(sv));
do_close(gv,FALSE);
continue;
#if !defined(DOSISH) && !defined(__CYGWIN__)
if (PerlLIO_rename(PL_oldname,SvPVX_const(sv)) < 0) {
Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE),
- "Can't rename %s to %"SVf": %s, skipping file",
- PL_oldname, SVfARG(sv), Strerror(errno));
+ "Can't rename %s to %" SVf
+ ": %s, skipping file",
+ PL_oldname, SVfARG(sv),
+ Strerror(errno));
do_close(gv,FALSE);
continue;
}
(void)UNLINK(SvPVX_const(sv));
if (link(PL_oldname,SvPVX_const(sv)) < 0) {
Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE),
- "Can't rename %s to %"SVf": %s, skipping file",
+ "Can't rename %s to %" SVf ": %s, skipping file",
PL_oldname, SVfARG(sv), Strerror(errno) );
do_close(gv,FALSE);
continue;
setdefout(PL_argvoutgv);
PL_lastfd = PerlIO_fileno(IoIFP(GvIOp(PL_argvoutgv)));
if (PL_lastfd >= 0) {
- (void)PerlLIO_fstat(PL_lastfd,&PL_statbuf);
+ (void)PerlLIO_fstat(PL_lastfd,&statbuf);
#ifdef HAS_FCHMOD
(void)fchmod(PL_lastfd,PL_filemode);
#else
(void)PerlLIO_chmod(PL_oldname,PL_filemode);
#endif
- if (fileuid != PL_statbuf.st_uid || filegid != PL_statbuf.st_gid) {
+ if (fileuid != statbuf.st_uid || filegid != statbuf.st_gid) {
/* XXX silently ignore failures */
#ifdef HAS_FCHOWN
PERL_UNUSED_RESULT(fchown(PL_lastfd,fileuid,filegid));
if (ckWARN_d(WARN_INPLACE)) {
const int eno = errno;
- if (PerlLIO_stat(PL_oldname, &PL_statbuf) >= 0
- && !S_ISREG(PL_statbuf.st_mode)) {
+ if (PerlLIO_stat(PL_oldname, &statbuf) >= 0
+ && !S_ISREG(statbuf.st_mode)) {
Perl_warner(aTHX_ packWARN(WARN_INPLACE),
"Can't do inplace edit: %s is not a regular file",
PL_oldname);
if (io && (IoFLAGS(io) & IOf_ARGV))
IoFLAGS(io) |= IOf_START;
if (PL_inplace) {
- (void)do_close(PL_argvoutgv,FALSE);
+ if (old_out_name) {
+ IO * const io = GvIOp(PL_argvoutgv);
+ if (io && IoIFP(io) && !io_close(io, PL_argvoutgv, FALSE, FALSE)) {
+ Perl_croak(aTHX_ "Failed to close in-place edit file %" SVf ": %s\n",
+ old_out_name, Strerror(errno));
+ }
+ }
+ else {
+ /* maybe this is no longer wanted */
+ (void)do_close(PL_argvoutgv,FALSE);
+ }
if (io && (IoFLAGS(io) & IOf_ARGV)
&& PL_argvout_stack && AvFILLp(PL_argvout_stack) >= 0)
{
if (gv)
Perl_ck_warner_d(aTHX_ packWARN(WARN_IO),
"Warning: unable to close filehandle %"
- HEKf" properly: %"SVf,
+ HEKf " properly: %" SVf,
HEKfARG(GvNAME_HEK(gv)),
SVfARG(get_sv("!",GV_ADD)));
else
Perl_ck_warner_d(aTHX_ packWARN(WARN_IO),
"Warning: unable to close filehandle "
- "properly: %"SVf,
+ "properly: %" SVf,
SVfARG(get_sv("!",GV_ADD)));
}
}
if (SvTYPE(sv) == SVt_IV && SvIOK(sv)) {
assert(!SvGMAGICAL(sv));
if (SvIsUV(sv))
- PerlIO_printf(fp, "%"UVuf, (UV)SvUVX(sv));
+ PerlIO_printf(fp, "%" UVuf, (UV)SvUVX(sv));
else
- PerlIO_printf(fp, "%"IVdf, (IV)SvIVX(sv));
+ PerlIO_printf(fp, "%" IVdf, (IV)SvIVX(sv));
return !PerlIO_error(fp);
}
else {
do_fstat_have_io:
PL_laststype = OP_STAT;
PL_statgv = gv ? gv : (GV *)io;
- sv_setpvs(PL_statname, "");
+ SvPVCLEAR(PL_statname);
if (io) {
if (IoIFP(io)) {
int fd = PerlIO_fileno(IoIFP(io));
if (ckWARN(WARN_IO)) {
/* diag_listed_as: Use of -l on filehandle%s */
Perl_warner(aTHX_ packWARN(WARN_IO),
- "Use of -l on filehandle %"HEKf,
+ "Use of -l on filehandle %" HEKf,
HEKfARG(GvENAME_HEK(cGVOP_gv)));
}
return -1;
else
/* diag_listed_as: Use of -l on filehandle%s */
Perl_warner(aTHX_ packWARN(WARN_IO),
- "Use of -l on filehandle %"HEKf,
+ "Use of -l on filehandle %" HEKf,
HEKfARG(GvENAME_HEK((const GV *)
(SvROK(sv) ? SvRV(sv) : sv))));
}
{
char flags[PERL_FLAGS_MAX];
if (strnEQ(cmd,PL_cshname,PL_cshlen) &&
- strnEQ(cmd+PL_cshlen," -c",3)) {
+ strEQs(cmd+PL_cshlen," -c")) {
my_strlcpy(flags, "-c", PERL_FLAGS_MAX);
s = cmd+PL_cshlen+3;
if (*s == 'f') {
if (*cmd == '.' && isSPACE(cmd[1]))
goto doshell;
- if (strnEQ(cmd,"exec",4) && isSPACE(cmd[4]))
+ if (strEQs(cmd,"exec") && isSPACE(cmd[4]))
goto doshell;
s = cmd;
len -= 3;
}
if ((val = whichsig_pvn(s, len)) < 0)
- Perl_croak(aTHX_ "Unrecognized signal name \"%"SVf"\"", SVfARG(*mark));
+ Perl_croak(aTHX_ "Unrecognized signal name \"%" SVf "\"",
+ SVfARG(*mark));
}
else
{
#endif
}
else { /* don't let root wipe out directories without -U */
- if (PerlLIO_lstat(s,&PL_statbuf) < 0)
- tot--;
- else if (S_ISDIR(PL_statbuf.st_mode)) {
+ Stat_t statbuf;
+ if (PerlLIO_lstat(s, &statbuf) < 0)
tot--;
+ else if (S_ISDIR(statbuf.st_mode)) {
SETERRNO(EISDIR, SS_NOPRIV);
+ tot--;
}
else {
if (UNLINK(s))
/* suppress warning when reading into undef var --jhi */
if (! SvOK(mstr))
- sv_setpvs(mstr, "");
+ SvPVCLEAR(mstr);
msize = SvIVx(*++mark);
mtype = (long)SvIVx(*++mark);
flags = SvIVx(*++mark);
SvGETMAGIC(mstr);
SvUPGRADE(mstr, SVt_PV);
if (! SvOK(mstr))
- sv_setpvs(mstr, "");
+ SvPVCLEAR(mstr);
SvPOK_only(mstr);
mbuf = SvGROW(mstr, (STRLEN)msize+1);
Function called by C<do_readline> to spawn a glob (or do the glob inside
perl on VMS). This code used to be inline, but now perl uses C<File::Glob>
-this glob starter is only used by miniperl during the build process.
+this glob starter is only used by miniperl during the build process,
+or when PERL_EXTERNAL_GLOB is defined.
Moving it away shrinks F<pp_hot.c>; shrinking F<pp_hot.c> helps speed perl up.
=cut
#endif /* !CSH */
#endif /* !DOSISH */
{
- GV * const envgv = gv_fetchpvs("ENV", 0, SVt_PVHV);
- SV ** const home = hv_fetchs(GvHV(envgv), "HOME", 0);
- SV ** const path = hv_fetchs(GvHV(envgv), "PATH", 0);
- if (home && *home) SvGETMAGIC(*home);
- if (path && *path) SvGETMAGIC(*path);
- save_hash(gv_fetchpvs("ENV", 0, SVt_PVHV));
- if (home && *home) SvSETMAGIC(*home);
- if (path && *path) SvSETMAGIC(*path);
+ SV ** const svp = hv_fetchs(GvHVn(PL_envgv), "LS_COLORS", 0);
+ if (svp && *svp)
+ save_helem_flags(GvHV(PL_envgv),
+ newSVpvs_flags("LS_COLORS", SVs_TEMP), svp,
+ SAVEf_SETMAGIC);
}
(void)do_open6(PL_last_in_gv, SvPVX_const(tmpcmd), SvCUR(tmpcmd),
NULL, NULL, 0);
https://perl5.git.perl.org / perl5.git / blobdiff