}
tmps = SvPV_const(sv, len);
- ok = do_openn(gv, tmps, len, FALSE, O_RDONLY, 0, NULL, MARK+1, (SP-MARK));
+ ok = do_open6(gv, tmps, len, NULL, MARK+1, (SP-MARK));
SP = ORIGMARK;
if (ok)
PUSHi( (I32)PL_forkprocess );
GV * const wgv = MUTABLE_GV(POPs);
GV * const rgv = MUTABLE_GV(POPs);
- if (!rgv || !wgv)
- goto badexit;
-
- if (!isGV_with_GP(rgv) || !isGV_with_GP(wgv))
- DIE(aTHX_ PL_no_usym, "filehandle");
+ assert (isGV_with_GP(rgv));
+ assert (isGV_with_GP(wgv));
rstio = GvIOn(rgv);
- wstio = GvIOn(wgv);
-
if (IoIFP(rstio))
do_close(rgv, FALSE);
+
+ wstio = GvIOn(wgv);
if (IoIFP(wstio))
do_close(wgv, FALSE);
goto badexit;
}
#if defined(HAS_FCNTL) && defined(F_SETFD)
- fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd); /* ensure close-on-exec */
- fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd); /* ensure close-on-exec */
+ /* ensure close-on-exec */
+ if ((fcntl(fd[0], F_SETFD,fd[0] > PL_maxsysfd) < 0) ||
+ (fcntl(fd[1], F_SETFD,fd[1] > PL_maxsysfd) < 0))
+ goto badexit;
#endif
RETPUSHYES;
=for apidoc setdefout
Sets PL_defoutgv, the default file handle for output, to the passed in
-typeglob. As PL_defoutgv "owns" a reference on its typeglob, the reference
+typeglob. As PL_defoutgv "owns" a reference on its typeglob, the reference
count of the passed in typeglob is increased by one, and the reference count
of the typeglob that PL_defoutgv points to is decreased by one.
}
SvUTF8_on(TARG);
}
+ else SvUTF8_off(TARG);
PUSHTARG;
RETURN;
}
PERL_ARGS_ASSERT_DOFORM;
- if (cv && CvCLONE(cv))
+ if (CvCLONE(cv))
cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv))));
ENTER;
SV *tmpsv = NULL;
if (MAXARG == 0) {
- gv = PL_defoutgv;
EXTEND(SP, 1);
+ gv = PL_defoutgv;
}
else {
gv = MUTABLE_GV(POPs);
/* Need TIEHANDLE method ? */
const char * const tmps = SvPV_const(sv, len);
- /* FIXME? do_open should do const */
- if (do_open(gv, tmps, len, TRUE, mode, perm, NULL)) {
+ if (do_open_raw(gv, tmps, len, mode, perm)) {
IoLINES(GvIOp(gv)) = 0;
PUSHs(&PL_sv_yes);
}
bool charstart = FALSE;
STRLEN charskip = 0;
STRLEN skip = 0;
-
GV * const gv = MUTABLE_GV(*++MARK);
+ int fd;
+
if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD)
&& gv && (io = GvIO(gv)) )
{
SETERRNO(EBADF,RMS_IFI);
goto say_undef;
}
+
+ /* Note that fd can here validly be -1, don't check it yet. */
+ fd = PerlIO_fileno(IoIFP(io));
+
if ((fp_utf8 = PerlIO_isutf8(IoIFP(io))) && !IN_BYTES) {
buffer = SvPVutf8_force(bufsv, blen);
/* UTF-8 may not have been set if they are all low bytes */
if (PL_op->op_type == OP_RECV) {
Sock_size_t bufsize;
char namebuf[MAXPATHLEN];
+ if (fd < 0) {
+ SETERRNO(EBADF,SS_IVCHAN);
+ RETPUSHUNDEF;
+ }
#if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(__QNXNTO__)
bufsize = sizeof (struct sockaddr_in);
#else
#endif
buffer = SvGROW(bufsv, (STRLEN)(length+1));
/* 'offset' means 'flags' here */
- count = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset,
+ count = PerlSock_recvfrom(fd, buffer, length, offset,
(struct sockaddr *)namebuf, &bufsize);
if (count < 0)
RETPUSHUNDEF;
if (!(IoFLAGS(io) & IOf_UNTAINT))
SvTAINTED_on(bufsv);
SP = ORIGMARK;
+#if defined(__CYGWIN__)
+ /* recvfrom() on cygwin doesn't set bufsize at all for
+ connected sockets, leaving us with trash in the returned
+ name, so use the same test as the Win32 code to check if it
+ wasn't set, and set it [perl #118843] */
+ if (bufsize == sizeof namebuf)
+ bufsize = 0;
+#endif
sv_setpvn(TARG, namebuf, bufsize);
PUSHs(TARG);
RETURN;
else
offset = utf8_hop((U8 *)buffer,offset) - (U8 *) buffer;
}
+
more_bytes:
+ /* Reestablish the fd in case it shifted from underneath us. */
+ fd = PerlIO_fileno(IoIFP(io));
+
orig_size = SvCUR(bufsv);
/* Allocating length + offset + 1 isn't perfect in the case of reading
bytes from a byte file handle into a UTF8 buffer, but it won't harm us
if (PL_op->op_type == OP_SYSREAD) {
#ifdef PERL_SOCK_SYSREAD_IS_RECV
if (IoTYPE(io) == IoTYPE_SOCKET) {
- count = PerlSock_recv(PerlIO_fileno(IoIFP(io)),
- buffer, length, 0);
+ if (fd < 0) {
+ SETERRNO(EBADF,SS_IVCHAN);
+ count = -1;
+ }
+ else
+ count = PerlSock_recv(fd, buffer, length, 0);
}
else
#endif
{
- count = PerlLIO_read(PerlIO_fileno(IoIFP(io)),
- buffer, length);
+ if (fd < 0) {
+ SETERRNO(EBADF,RMS_IFI);
+ count = -1;
+ }
+ else
+ count = PerlLIO_read(fd, buffer, length);
}
}
else
U8 *tmpbuf = NULL;
GV *const gv = MUTABLE_GV(*++MARK);
IO *const io = GvIO(gv);
+ int fd;
if (op_type == OP_SYSWRITE && io) {
const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
SETERRNO(EBADF,RMS_IFI);
goto say_undef;
}
+ fd = PerlIO_fileno(IoIFP(io));
+ if (fd < 0) {
+ SETERRNO(EBADF,SS_IVCHAN);
+ retval = -1;
+ goto say_undef;
+ }
/* Do this first to trigger any overloading. */
buffer = SvPV_const(bufsv, blen);
if (SP > MARK) {
STRLEN mlen;
char * const sockbuf = SvPVx(*++MARK, mlen);
- retval = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen,
+ retval = PerlSock_sendto(fd, buffer, blen,
flags, (struct sockaddr *)sockbuf, mlen);
}
else {
- retval
- = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, flags);
+ retval = PerlSock_send(fd, buffer, blen, flags);
}
}
else
}
#ifdef PERL_SOCK_SYSWRITE_IS_SEND
if (IoTYPE(io) == IoTYPE_SOCKET) {
- retval = PerlSock_send(PerlIO_fileno(IoIFP(io)),
- buffer, length, 0);
+ retval = PerlSock_send(fd, buffer, length, 0);
}
else
#endif
{
/* See the note at doio.c:do_print about filesize limits. --jhi */
- retval = PerlLIO_write(PerlIO_fileno(IoIFP(io)),
- buffer, length);
+ retval = PerlLIO_write(fd, buffer, length);
}
}
if (!MAXARG && (PL_op->op_flags & OPf_SPECIAL)) { /* eof() */
if (io && !IoIFP(io)) {
- if ((IoFLAGS(io) & IOf_START) && av_len(GvAVn(gv)) < 0) {
+ if ((IoFLAGS(io) & IOf_START) && av_tindex(GvAVn(gv)) < 0) {
IoLINES(io) = 0;
IoFLAGS(io) &= ~IOf_START;
- do_open(gv, "-", 1, FALSE, O_RDONLY, 0, NULL);
+ do_open6(gv, "-", 1, NULL, NULL, 0);
if (GvSV(gv))
sv_setpvs(GvSV(gv), "-");
else
result = 0;
}
else {
- PerlIO_flush(fp);
+ int fd = PerlIO_fileno(fp);
+ if (fd < 0) {
+ SETERRNO(EBADF,RMS_IFI);
+ result = 0;
+ } else {
+ PerlIO_flush(fp);
#ifdef HAS_TRUNCATE
- if (ftruncate(PerlIO_fileno(fp), len) < 0)
+ if (ftruncate(fd, len) < 0)
#else
- if (my_chsize(PerlIO_fileno(fp), len) < 0)
+ if (my_chsize(fd, len) < 0)
#endif
- result = 0;
+ result = 0;
+ }
}
}
}
{
const int tmpfd = PerlLIO_open(name, O_RDWR);
- if (tmpfd < 0)
+ if (tmpfd < 0) {
+ SETERRNO(EBADF,RMS_IFI);
result = 0;
- else {
+ } else {
if (my_chsize(tmpfd, len) < 0)
result = 0;
PerlLIO_close(tmpfd);
dVAR; dSP; dTARGET;
SV * const argsv = POPs;
const unsigned int func = POPu;
- const int optype = PL_op->op_type;
+ int optype;
GV * const gv = MUTABLE_GV(POPs);
- IO * const io = gv ? GvIOn(gv) : NULL;
+ IO * const io = GvIOn(gv);
char *s;
IV retval;
- if (!io || !argsv || !IoIFP(io)) {
+ if (!IoIFP(io)) {
report_evil_fh(gv);
SETERRNO(EBADF,RMS_IFI); /* well, sort of... */
RETPUSHUNDEF;
s = INT2PTR(char*,retval); /* ouch */
}
+ optype = PL_op->op_type;
TAINT_PROPER(PL_op_desc[optype]);
if (optype == OP_IOCTL)
const int type = POPi;
const int domain = POPi;
GV * const gv = MUTABLE_GV(POPs);
- IO * const io = gv ? GvIOn(gv) : NULL;
+ IO * const io = GvIOn(gv);
int fd;
- if (!io) {
- report_evil_fh(gv);
- if (io && IoIFP(io))
- do_close(gv, FALSE);
- SETERRNO(EBADF,LIB_INVARG);
- RETPUSHUNDEF;
- }
-
if (IoIFP(io))
do_close(gv, FALSE);
TAINT_PROPER("socket");
fd = PerlSock_socket(domain, type, protocol);
- if (fd < 0)
+ if (fd < 0) {
+ SETERRNO(EBADF,RMS_IFI);
RETPUSHUNDEF;
+ }
IoIFP(io) = PerlIO_fdopen(fd, "r"SOCKET_OPEN_MODE); /* stdio gets confused about sockets */
IoOFP(io) = PerlIO_fdopen(fd, "w"SOCKET_OPEN_MODE);
IoTYPE(io) = IoTYPE_SOCKET;
RETPUSHUNDEF;
}
#if defined(HAS_FCNTL) && defined(F_SETFD)
- fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */
+ if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0) /* ensure close-on-exec */
+ RETPUSHUNDEF;
#endif
RETPUSHYES;
{
#if defined (HAS_SOCKETPAIR) || (defined (HAS_SOCKET) && defined(SOCK_DGRAM) && defined(AF_INET) && defined(PF_INET))
dVAR; dSP;
+ int fd[2];
const int protocol = POPi;
const int type = POPi;
const int domain = POPi;
+
GV * const gv2 = MUTABLE_GV(POPs);
+ IO * const io2 = GvIOn(gv2);
GV * const gv1 = MUTABLE_GV(POPs);
- IO * const io1 = gv1 ? GvIOn(gv1) : NULL;
- IO * const io2 = gv2 ? GvIOn(gv2) : NULL;
- int fd[2];
-
- if (!io1)
- report_evil_fh(gv1);
- if (!io2)
- report_evil_fh(gv2);
+ IO * const io1 = GvIOn(gv1);
- if (io1 && IoIFP(io1))
+ if (IoIFP(io1))
do_close(gv1, FALSE);
- if (io2 && IoIFP(io2))
+ if (IoIFP(io2))
do_close(gv2, FALSE);
- if (!io1 || !io2)
- RETPUSHUNDEF;
-
TAINT_PROPER("socketpair");
if (PerlSock_socketpair(domain, type, protocol, fd) < 0)
RETPUSHUNDEF;
RETPUSHUNDEF;
}
#if defined(HAS_FCNTL) && defined(F_SETFD)
- fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd); /* ensure close-on-exec */
- fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd); /* ensure close-on-exec */
+ /* ensure close-on-exec */
+ if ((fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd) < 0) ||
+ (fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd) < 0))
+ RETPUSHUNDEF;
#endif
RETPUSHYES;
GV * const gv = MUTABLE_GV(POPs);
IO * const io = GvIOn(gv);
STRLEN len;
- const int op_type = PL_op->op_type;
+ int op_type;
+ int fd;
- if (!io || !IoIFP(io))
+ if (!IoIFP(io))
goto nuts;
+ fd = PerlIO_fileno(IoIFP(io));
+ if (fd < 0)
+ goto nuts;
addr = SvPV_const(addrsv, len);
+ op_type = PL_op->op_type;
TAINT_PROPER(PL_op_desc[op_type]);
if ((op_type == OP_BIND
- ? PerlSock_bind(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len)
- : PerlSock_connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len))
+ ? PerlSock_bind(fd, (struct sockaddr *)addr, len)
+ : PerlSock_connect(fd, (struct sockaddr *)addr, len))
>= 0)
RETPUSHYES;
else
dVAR; dSP;
const int backlog = POPi;
GV * const gv = MUTABLE_GV(POPs);
- IO * const io = gv ? GvIOn(gv) : NULL;
+ IO * const io = GvIOn(gv);
- if (!io || !IoIFP(io))
+ if (!IoIFP(io))
goto nuts;
if (PerlSock_listen(PerlIO_fileno(IoIFP(io)), backlog) >= 0)
{
dVAR; dSP; dTARGET;
IO *nstio;
- IO *gstio;
char namebuf[MAXPATHLEN];
#if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(__QNXNTO__)
Sock_size_t len = sizeof (struct sockaddr_in);
GV * const ngv = MUTABLE_GV(POPs);
int fd;
- if (!ngv)
- goto badexit;
- if (!ggv)
- goto nuts;
-
- gstio = GvIO(ggv);
+ IO * const gstio = GvIO(ggv);
if (!gstio || !IoIFP(gstio))
goto nuts;
goto badexit;
}
#if defined(HAS_FCNTL) && defined(F_SETFD)
- fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */
+ if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0) /* ensure close-on-exec */
+ goto badexit;
#endif
#ifdef __SCO_VERSION__
GV * const gv = MUTABLE_GV(POPs);
IO * const io = GvIOn(gv);
- if (!io || !IoIFP(io))
+ if (!IoIFP(io))
goto nuts;
PUSHi( PerlSock_shutdown(PerlIO_fileno(IoIFP(io)), how) >= 0 );
int fd;
Sock_size_t len;
- if (!io || !IoIFP(io))
+ if (!IoIFP(io))
goto nuts;
fd = PerlIO_fileno(IoIFP(io));
+ if (fd < 0)
+ goto nuts;
switch (optype) {
case OP_GSOCKOPT:
SvGROW(sv, 257);
SV *sv;
int fd;
- if (!io || !IoIFP(io))
+ if (!IoIFP(io))
goto nuts;
sv = sv_2mortal(newSV(257));
SvCUR_set(sv, len);
*SvEND(sv) ='\0';
fd = PerlIO_fileno(IoIFP(io));
+ if (fd < 0)
+ goto nuts;
switch (optype) {
case OP_GETSOCKNAME:
if (PerlSock_getsockname(fd, (struct sockaddr *)SvPVX(sv), &len) < 0)
}
if (io) {
if (IoIFP(io)) {
- PL_laststatval =
- PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache);
- havefp = TRUE;
+ int fd = PerlIO_fileno(IoIFP(io));
+ if (fd < 0) {
+ PL_laststatval = -1;
+ SETERRNO(EBADF,RMS_IFI);
+ } else {
+ PL_laststatval = PerlLIO_fstat(fd, &PL_statcache);
+ havefp = TRUE;
+ }
} else if (IoDIRP(io)) {
PL_laststatval =
PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache);
}
}
else {
+ const char *file;
if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) {
io = MUTABLE_IO(SvRV(sv));
if (PL_op->op_type == OP_LSTAT)
sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv));
PL_statgv = NULL;
PL_laststype = PL_op->op_type;
+ file = SvPV_nolen_const(PL_statname);
if (PL_op->op_type == OP_LSTAT)
- PL_laststatval = PerlLIO_lstat(SvPV_nolen_const(PL_statname), &PL_statcache);
+ PL_laststatval = PerlLIO_lstat(file, &PL_statcache);
else
- PL_laststatval = PerlLIO_stat(SvPV_nolen_const(PL_statname), &PL_statcache);
+ PL_laststatval = PerlLIO_stat(file, &PL_statcache);
if (PL_laststatval < 0) {
- if (ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen_const(PL_statname), '\n'))
+ if (ckWARN(WARN_NEWLINE) && should_warn_nl(file)) {
+ /* PL_warn_nl is constant */
+ GCC_DIAG_IGNORE(-Wformat-nonliteral);
Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat");
+ GCC_DIAG_RESTORE;
+ }
max = 0;
}
}
if (GvIO(gv) && IoIFP(GvIOp(gv)))
fd = PerlIO_fileno(IoIFP(GvIOp(gv)));
else if (name && isDIGIT(*name))
- fd = atoi(name);
+ fd = atoi(name);
else
FT_RETURNUNDEF;
+ if (fd < 0) {
+ SETERRNO(EBADF,RMS_IFI);
+ FT_RETURNUNDEF;
+ }
if (PerlLIO_isatty(fd))
FT_RETURNYES;
FT_RETURNNO;
PL_laststatval = -1;
PL_laststype = OP_STAT;
if (io && IoIFP(io)) {
+ int fd;
if (! PerlIO_has_base(IoIFP(io)))
DIE(aTHX_ "-T and -B not implemented on filehandles");
- PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache);
+ fd = PerlIO_fileno(IoIFP(io));
+ if (fd < 0) {
+ SETERRNO(EBADF,RMS_IFI);
+ FT_RETURNUNDEF;
+ }
+ PL_laststatval = PerlLIO_fstat(fd, &PL_statcache);
if (PL_laststatval < 0)
FT_RETURNUNDEF;
if (S_ISDIR(PL_statcache.st_mode)) { /* handle NFS glitch */
i = PerlIO_getc(IoIFP(io));
if (i != EOF)
(void)PerlIO_ungetc(IoIFP(io),i);
+ else
+ /* null file is anything */
+ FT_RETURNYES;
}
- if (PerlIO_get_cnt(IoIFP(io)) <= 0) /* null file is anything */
- FT_RETURNYES;
len = PerlIO_get_bufsiz(IoIFP(io));
s = (STDCHAR *) PerlIO_get_base(IoIFP(io));
/* sfio can have large buffers - limit to 512 */
}
}
else {
+ const char *file;
+ int fd;
+
sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv));
really_filename:
+ file = SvPVX_const(PL_statname);
PL_statgv = NULL;
- if (!(fp = PerlIO_open(SvPVX_const(PL_statname), "r"))) {
+ if (!(fp = PerlIO_open(file, "r"))) {
if (!gv) {
PL_laststatval = -1;
PL_laststype = OP_STAT;
}
- if (ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen_const(PL_statname),
- '\n'))
+ if (ckWARN(WARN_NEWLINE) && should_warn_nl(file)) {
+ /* PL_warn_nl is constant */
+ GCC_DIAG_IGNORE(-Wformat-nonliteral);
Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
+ GCC_DIAG_RESTORE;
+ }
FT_RETURNUNDEF;
}
PL_laststype = OP_STAT;
- PL_laststatval = PerlLIO_fstat(PerlIO_fileno(fp), &PL_statcache);
+ fd = PerlIO_fileno(fp);
+ if (fd < 0) {
+ (void)PerlIO_close(fp);
+ SETERRNO(EBADF,RMS_IFI);
+ FT_RETURNUNDEF;
+ }
+ PL_laststatval = PerlLIO_fstat(fd, &PL_statcache);
if (PL_laststatval < 0) {
(void)PerlIO_close(fp);
+ SETERRNO(EBADF,RMS_IFI);
FT_RETURNUNDEF;
}
PerlIO_binmode(aTHX_ fp, '<', O_BINARY, NULL);
if (IoDIRP(io)) {
PUSHi(fchdir(my_dirfd(IoDIRP(io))) >= 0);
} else if (IoIFP(io)) {
- PUSHi(fchdir(PerlIO_fileno(IoIFP(io))) >= 0);
+ int fd = PerlIO_fileno(IoIFP(io));
+ if (fd < 0) {
+ goto nuts;
+ }
+ PUSHi(fchdir(fd) >= 0);
}
else {
- report_evil_fh(gv);
- SETERRNO(EBADF, RMS_IFI);
- PUSHi(0);
+ goto nuts;
}
+ } else {
+ goto nuts;
}
- else {
- report_evil_fh(gv);
- SETERRNO(EBADF,RMS_IFI);
- PUSHi(0);
- }
+
#else
DIE(aTHX_ PL_no_func, "fchdir");
#endif
hv_delete(GvHVn(PL_envgv),"DEFAULT",7,G_DISCARD);
#endif
RETURN;
+
+ nuts:
+ report_evil_fh(gv);
+ SETERRNO(EBADF,RMS_IFI);
+ PUSHi(0);
+ RETURN;
}
PP(pp_chown)
GV * const gv = MUTABLE_GV(POPs);
IO * const io = GvIOn(gv);
- if (!io)
- goto nope;
-
if ((IoIFP(io) || IoOFP(io)))
Perl_ck_warner_d(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
"Opening filehandle %"HEKf" also as a directory",
const Direntry_t *dp;
IO * const io = GvIOn(gv);
- if (!io || !IoDIRP(io)) {
+ if (!IoDIRP(io)) {
Perl_ck_warner(aTHX_ packWARN(WARN_IO),
"readdir() attempted on invalid dirhandle %"HEKf,
HEKfARG(GvENAME_HEK(gv)));
} while (gimme == G_ARRAY);
if (!dp && gimme != G_ARRAY)
- goto nope;
+ RETPUSHUNDEF;
RETURN;
GV * const gv = MUTABLE_GV(POPs);
IO * const io = GvIOn(gv);
- if (!io || !IoDIRP(io)) {
+ if (!IoDIRP(io)) {
Perl_ck_warner(aTHX_ packWARN(WARN_IO),
"telldir() attempted on invalid dirhandle %"HEKf,
HEKfARG(GvENAME_HEK(gv)));
GV * const gv = MUTABLE_GV(POPs);
IO * const io = GvIOn(gv);
- if (!io || !IoDIRP(io)) {
+ if (!IoDIRP(io)) {
Perl_ck_warner(aTHX_ packWARN(WARN_IO),
"seekdir() attempted on invalid dirhandle %"HEKf,
HEKfARG(GvENAME_HEK(gv)));
GV * const gv = MUTABLE_GV(POPs);
IO * const io = GvIOn(gv);
- if (!io || !IoDIRP(io)) {
+ if (!IoDIRP(io)) {
Perl_ck_warner(aTHX_ packWARN(WARN_IO),
"rewinddir() attempted on invalid dirhandle %"HEKf,
HEKfARG(GvENAME_HEK(gv)));
GV * const gv = MUTABLE_GV(POPs);
IO * const io = GvIOn(gv);
- if (!io || !IoDIRP(io)) {
+ if (!IoDIRP(io)) {
Perl_ck_warner(aTHX_ packWARN(WARN_IO),
"closedir() attempted on invalid dirhandle %"HEKf,
HEKfARG(GvENAME_HEK(gv)));
if (did_pipes) {
PerlLIO_close(pp[0]);
#if defined(HAS_FCNTL) && defined(F_SETFD)
- fcntl(pp[1], F_SETFD, FD_CLOEXEC);
+ if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0)
+ RETPUSHUNDEF;
#endif
}
if (PL_op->op_flags & OPf_STACKED) {
#ifdef HAS_TIMES
dVAR;
dSP;
+ struct tms timesbuf;
+
EXTEND(SP, 4);
-#ifndef VMS
- (void)PerlProc_times(&PL_timesbuf);
-#else
- (void)PerlProc_times((tbuffer_t *)&PL_timesbuf); /* time.h uses different name for */
- /* struct tms, though same data */
- /* is returned. */
-#endif
+ (void)PerlProc_times(×buf);
- mPUSHn(((NV)PL_timesbuf.tms_utime)/(NV)PL_clocktick);
+ mPUSHn(((NV)timesbuf.tms_utime)/(NV)PL_clocktick);
if (GIMME == G_ARRAY) {
- mPUSHn(((NV)PL_timesbuf.tms_stime)/(NV)PL_clocktick);
- mPUSHn(((NV)PL_timesbuf.tms_cutime)/(NV)PL_clocktick);
- mPUSHn(((NV)PL_timesbuf.tms_cstime)/(NV)PL_clocktick);
+ mPUSHn(((NV)timesbuf.tms_stime)/(NV)PL_clocktick);
+ mPUSHn(((NV)timesbuf.tms_cutime)/(NV)PL_clocktick);
+ mPUSHn(((NV)timesbuf.tms_cstime)/(NV)PL_clocktick);
}
RETURN;
#else
else {
NV input = Perl_floor(POPn);
when = (Time64_T)input;
- if (NV_ne_nowarn(when, input)) {
+ if (when != input) {
/* diag_listed_as: gmtime(%f) too large */
Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
"%s(%.0" NVff ") too large", opname, input);
}
if (err == NULL) {
+ /* diag_listed_as: gmtime(%f) failed */
/* XXX %lld broken for quads */
Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
"%s(%.0" NVff ") failed", opname, when);
}
if (GIMME != G_ARRAY) { /* scalar context */
- SV *tsv;
- /* XXX newSVpvf()'s %lld type is broken, so cheat with a double */
- double year = (double)tmbuf.tm_year + 1900;
-
EXTEND(SP, 1);
EXTEND_MORTAL(1);
if (err == NULL)
RETPUSHUNDEF;
-
- tsv = Perl_newSVpvf(aTHX_ "%s %s %2d %02d:%02d:%02d %.0f",
- dayname[tmbuf.tm_wday],
- monname[tmbuf.tm_mon],
- tmbuf.tm_mday,
- tmbuf.tm_hour,
- tmbuf.tm_min,
- tmbuf.tm_sec,
- year);
- mPUSHs(tsv);
+ else {
+ mPUSHs(Perl_newSVpvf(aTHX_ "%s %s %2d %02d:%02d:%02d %.0f",
+ dayname[tmbuf.tm_wday],
+ monname[tmbuf.tm_mon],
+ tmbuf.tm_mday,
+ tmbuf.tm_hour,
+ tmbuf.tm_min,
+ tmbuf.tm_sec,
+ /* XXX newSVpvf()'s %lld type is broken,
+ * so cheat with a double */
+ (double)tmbuf.tm_year + 1900));
+ }
}
else { /* list context */
if ( err == NULL )
https://perl5.git.perl.org / perl5.git / blobdiff