djSP; dTARGET;
GV *gv;
SV *sv;
- SV *name;
+ SV *name = Nullsv;
I32 have_name = 0;
char *tmps;
STRLEN len;
IoIFP(rstio) = PerlIO_fdopen(fd[0], "r");
IoOFP(wstio) = PerlIO_fdopen(fd[1], "w");
IoIFP(wstio) = IoOFP(wstio);
- IoTYPE(rstio) = '<';
- IoTYPE(wstio) = '>';
+ IoTYPE(rstio) = IoTYPE_RDONLY;
+ IoTYPE(wstio) = IoTYPE_WRONLY;
if (!IoIFP(rstio) || !IoOFP(wstio)) {
if (IoIFP(rstio)) PerlIO_close(IoIFP(rstio));
cv = GvFORM(fgv);
if (!cv) {
+ char *name = NULL;
if (fgv) {
SV *tmpsv = sv_newmortal();
gv_efullname4(tmpsv, fgv, Nullch, FALSE);
- DIE(aTHX_ "Undefined format \"%s\" called",SvPVX(tmpsv));
+ name = SvPV_nolen(tmpsv);
}
+ if (name && *name)
+ DIE(aTHX_ "Undefined format \"%s\" called", name);
DIE(aTHX_ "Not a format reference");
}
if (CvCLONE(cv))
if (!fgv)
DIE(aTHX_ "bad top format reference");
cv = GvFORM(fgv);
- if (!cv) {
- SV *tmpsv = sv_newmortal();
- gv_efullname4(tmpsv, fgv, Nullch, FALSE);
- DIE(aTHX_ "Undefined top format \"%s\" called",SvPVX(tmpsv));
+ {
+ char *name = NULL;
+ if (!cv) {
+ SV *sv = sv_newmortal();
+ gv_efullname4(sv, fgv, Nullch, FALSE);
+ name = SvPV_nolen(sv);
+ }
+ if (name && *name)
+ DIE(aTHX_ "Undefined top format \"%s\" called",name);
+ /* why no:
+ else
+ DIE(aTHX_ "Undefined top format called");
+ ?*/
}
if (CvCLONE(cv))
cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
if (!fp) {
if (ckWARN2(WARN_CLOSED,WARN_IO)) {
if (IoIFP(io)) {
- SV* sv = sv_newmortal();
- gv_efullname4(sv, gv, Nullch, FALSE);
- Perl_warner(aTHX_ WARN_IO,
- "Filehandle %s opened only for input",
- SvPV_nolen(sv));
+ /* integrate with report_evil_fh()? */
+ char *name = NULL;
+ if (isGV(gv)) {
+ SV* sv = sv_newmortal();
+ gv_efullname4(sv, gv, Nullch, FALSE);
+ name = SvPV_nolen(sv);
+ }
+ if (name && *name)
+ Perl_warner(aTHX_ WARN_IO,
+ "Filehandle %s opened only for input", name);
+ else
+ Perl_warner(aTHX_ WARN_IO,
+ "Filehandle opened only for input");
}
else if (ckWARN(WARN_CLOSED))
- report_closed_fh(gv, io, "write", "filehandle");
+ report_evil_fh(gv, io, PL_op->op_type);
}
PUSHs(&PL_sv_no);
}
sv = NEWSV(0,0);
if (!(io = GvIO(gv))) {
- if (ckWARN(WARN_UNOPENED)) {
- gv_efullname4(sv, gv, Nullch, FALSE);
- Perl_warner(aTHX_ WARN_UNOPENED,
- "Filehandle %s never opened", SvPV(sv,n_a));
- }
+ dTHR;
+ if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+ report_evil_fh(gv, io, PL_op->op_type);
SETERRNO(EBADF,RMS$_IFI);
goto just_say_no;
}
else if (!(fp = IoOFP(io))) {
if (ckWARN2(WARN_CLOSED,WARN_IO)) {
+ /* integrate with report_evil_fh()? */
if (IoIFP(io)) {
- gv_efullname4(sv, gv, Nullch, FALSE);
- Perl_warner(aTHX_ WARN_IO,
- "Filehandle %s opened only for input",
- SvPV(sv,n_a));
+ char *name = NULL;
+ if (isGV(gv)) {
+ gv_efullname4(sv, gv, Nullch, FALSE);
+ name = SvPV_nolen(sv);
+ }
+ if (name && *name)
+ Perl_warner(aTHX_ WARN_IO,
+ "Filehandle %s opened only for input", name);
+ else
+ Perl_warner(aTHX_ WARN_IO,
+ "Filehandle opened only for input");
}
else if (ckWARN(WARN_CLOSED))
- report_closed_fh(gv, io, "printf", "filehandle");
+ report_evil_fh(gv, io, PL_op->op_type);
}
SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
goto just_say_no;
}
if (PL_op->op_type == OP_SYSREAD) {
#ifdef PERL_SOCK_SYSREAD_IS_RECV
- if (IoTYPE(io) == 's') {
+ if (IoTYPE(io) == IoTYPE_SOCKET) {
length = PerlSock_recv(PerlIO_fileno(IoIFP(io)),
buffer+offset, length, 0);
}
}
else
#ifdef HAS_SOCKET__bad_code_maybe
- if (IoTYPE(io) == 's') {
+ if (IoTYPE(io) == IoTYPE_SOCKET) {
char namebuf[MAXPATHLEN];
#if defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)
bufsize = sizeof (struct sockaddr_in);
length = -1;
}
if (length < 0) {
- if ((IoTYPE(io) == '>' || IoIFP(io) == PerlIO_stdout()
+ if ((IoTYPE(io) == IoTYPE_WRONLY || IoIFP(io) == PerlIO_stdout()
|| IoIFP(io) == PerlIO_stderr()) && ckWARN(WARN_IO))
{
- SV* sv = sv_newmortal();
- gv_efullname4(sv, gv, Nullch, FALSE);
- Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for output",
- SvPV_nolen(sv));
+ /* integrate with report_evil_fh()? */
+ char *name = NULL;
+ if (isGV(gv)) {
+ SV* sv = sv_newmortal();
+ gv_efullname4(sv, gv, Nullch, FALSE);
+ name = SvPV_nolen(sv);
+ }
+ if (name && *name)
+ Perl_warner(aTHX_ WARN_IO,
+ "Filehandle %s opened only for output", name);
+ else
+ Perl_warner(aTHX_ WARN_IO,
+ "Filehandle opened only for output");
}
goto say_undef;
}
io = GvIO(gv);
if (!io || !IoIFP(io)) {
retval = -1;
- if (ckWARN(WARN_CLOSED)) {
- if (PL_op->op_type == OP_SYSWRITE)
- report_closed_fh(gv, io, "syswrite", "filehandle");
- else
- report_closed_fh(gv, io, "send", "socket");
- }
+ if (ckWARN(WARN_CLOSED))
+ report_evil_fh(gv, io, PL_op->op_type);
}
else if (PL_op->op_type == OP_SYSWRITE) {
if (MARK < SP) {
if (length > blen - offset)
length = blen - offset;
#ifdef PERL_SOCK_SYSWRITE_IS_SEND
- if (IoTYPE(io) == 's') {
+ if (IoTYPE(io) == IoTYPE_SOCKET) {
retval = PerlSock_send(PerlIO_fileno(IoIFP(io)),
buffer+offset, length, 0);
}
I32 value;
int argtype;
GV *gv;
+ IO *io = NULL;
PerlIO *fp;
#ifdef FLOCK
gv = PL_last_in_gv;
else
gv = (GV*)POPs;
- if (gv && GvIO(gv))
- fp = IoIFP(GvIOp(gv));
- else
+ if (gv && (io = GvIO(gv)))
+ fp = IoIFP(io);
+ else {
fp = Nullfp;
+ io = NULL;
+ }
if (fp) {
(void)PerlIO_flush(fp);
value = (I32)(PerlLIO_flock(PerlIO_fileno(fp), argtype) >= 0);
}
else {
+ if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+ report_evil_fh(gv, io, PL_op->op_type);
value = 0;
SETERRNO(EBADF,RMS$_IFI);
- if (ckWARN(WARN_CLOSED))
- report_closed_fh(gv, GvIO(gv), "flock", "filehandle");
}
PUSHi(value);
RETURN;
RETPUSHUNDEF;
IoIFP(io) = PerlIO_fdopen(fd, "r"); /* stdio gets confused about sockets */
IoOFP(io) = PerlIO_fdopen(fd, "w");
- IoTYPE(io) = 's';
+ IoTYPE(io) = IoTYPE_SOCKET;
if (!IoIFP(io) || !IoOFP(io)) {
if (IoIFP(io)) PerlIO_close(IoIFP(io));
if (IoOFP(io)) PerlIO_close(IoOFP(io));
RETPUSHUNDEF;
IoIFP(io1) = PerlIO_fdopen(fd[0], "r");
IoOFP(io1) = PerlIO_fdopen(fd[0], "w");
- IoTYPE(io1) = 's';
+ IoTYPE(io1) = IoTYPE_SOCKET;
IoIFP(io2) = PerlIO_fdopen(fd[1], "r");
IoOFP(io2) = PerlIO_fdopen(fd[1], "w");
- IoTYPE(io2) = 's';
+ IoTYPE(io2) = IoTYPE_SOCKET;
if (!IoIFP(io1) || !IoOFP(io1) || !IoIFP(io2) || !IoOFP(io2)) {
if (IoIFP(io1)) PerlIO_close(IoIFP(io1));
if (IoOFP(io1)) PerlIO_close(IoOFP(io1));
nuts:
if (ckWARN(WARN_CLOSED))
- report_closed_fh(gv, io, "bind", "socket");
+ report_evil_fh(gv, io, PL_op->op_type);
SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
nuts:
if (ckWARN(WARN_CLOSED))
- report_closed_fh(gv, io, "connect", "socket");
+ report_evil_fh(gv, io, PL_op->op_type);
SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
nuts:
if (ckWARN(WARN_CLOSED))
- report_closed_fh(gv, io, "listen", "socket");
+ report_evil_fh(gv, io, PL_op->op_type);
SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
goto badexit;
IoIFP(nstio) = PerlIO_fdopen(fd, "r");
IoOFP(nstio) = PerlIO_fdopen(fd, "w");
- IoTYPE(nstio) = 's';
+ IoTYPE(nstio) = IoTYPE_SOCKET;
if (!IoIFP(nstio) || !IoOFP(nstio)) {
if (IoIFP(nstio)) PerlIO_close(IoIFP(nstio));
if (IoOFP(nstio)) PerlIO_close(IoOFP(nstio));
nuts:
if (ckWARN(WARN_CLOSED))
- report_closed_fh(ggv, ggv ? GvIO(ggv) : 0, "accept", "socket");
+ report_evil_fh(ggv, ggv ? GvIO(ggv) : 0, PL_op->op_type);
SETERRNO(EBADF,SS$_IVCHAN);
badexit:
nuts:
if (ckWARN(WARN_CLOSED))
- report_closed_fh(gv, io, "shutdown", "socket");
+ report_evil_fh(gv, io, PL_op->op_type);
SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
nuts:
if (ckWARN(WARN_CLOSED))
- report_closed_fh(gv, io,
- optype == OP_GSOCKOPT ? "getsockopt" : "setsockopt",
- "socket");
+ report_evil_fh(gv, io, optype);
SETERRNO(EBADF,SS$_IVCHAN);
nuts2:
RETPUSHUNDEF;
nuts:
if (ckWARN(WARN_CLOSED))
- report_closed_fh(gv, io,
- optype == OP_GETSOCKNAME ? "getsockname"
- : "getpeername",
- "socket");
+ report_evil_fh(gv, io, optype);
SETERRNO(EBADF,SS$_IVCHAN);
nuts2:
RETPUSHUNDEF;
PP(pp_stat)
{
djSP;
- GV *tmpgv;
+ GV *gv;
I32 gimme;
I32 max = 13;
STRLEN n_a;
if (PL_op->op_flags & OPf_REF) {
- tmpgv = cGVOP_gv;
+ gv = cGVOP_gv;
+ if (PL_op->op_type == OP_LSTAT && ckWARN(WARN_IO))
+ Perl_warner(aTHX_ WARN_IO,
+ "lstat() on filehandle %s", GvENAME(gv));
do_fstat:
- if (tmpgv != PL_defgv) {
+ if (gv != PL_defgv) {
PL_laststype = OP_STAT;
- PL_statgv = tmpgv;
+ PL_statgv = gv;
sv_setpv(PL_statname, "");
- PL_laststatval = (GvIO(tmpgv) && IoIFP(GvIOp(tmpgv))
- ? PerlLIO_fstat(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), &PL_statcache) : -1);
+ PL_laststatval = (GvIO(gv) && IoIFP(GvIOp(gv))
+ ? PerlLIO_fstat(PerlIO_fileno(IoIFP(GvIOn(gv))), &PL_statcache) : -1);
}
if (PL_laststatval < 0) {
- if (ckWARN(WARN_UNOPENED))
- Perl_warner(aTHX_ WARN_UNOPENED, "%s() on unopened filehandle %s",
- PL_op_desc[PL_op->op_type], GvENAME(tmpgv));
+ dTHR;
+ if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+ report_evil_fh(gv, GvIO(gv), PL_op->op_type);
max = 0;
}
}
else {
SV* sv = POPs;
if (SvTYPE(sv) == SVt_PVGV) {
- tmpgv = (GV*)sv;
+ gv = (GV*)sv;
goto do_fstat;
}
else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
- tmpgv = (GV*)SvRV(sv);
+ gv = (GV*)SvRV(sv);
goto do_fstat;
}
sv_setpv(PL_statname, SvPV(sv,n_a));
len = 512;
}
else {
- if (ckWARN(WARN_UNOPENED)) {
+ dTHR;
+ if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) {
gv = cGVOP_gv;
- Perl_warner(aTHX_ WARN_UNOPENED, "%s on unopened filehandle %s",
- PL_op_desc[PL_op->op_type], GvENAME(gv));
+ report_evil_fh(gv, GvIO(gv), PL_op->op_type);
}
SETERRNO(EBADF,RMS$_IFI);
RETPUSHUNDEF;
int argflags;
childpid = wait4pid(-1, &argflags, 0);
+# if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
+ /* 0 and -1 are both error returns (the former applies to WNOHANG case) */
+ STATUS_NATIVE_SET((childpid && childpid != -1) ? argflags : -1);
+# else
STATUS_NATIVE_SET((childpid > 0) ? argflags : -1);
+# endif
XPUSHi(childpid);
RETURN;
#else
optype = POPi;
childpid = TOPi;
childpid = wait4pid(childpid, &argflags, optype);
+# if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
+ /* 0 and -1 are both error returns (the former applies to WNOHANG case) */
+ STATUS_NATIVE_SET((childpid && childpid != -1) ? argflags : -1);
+# else
STATUS_NATIVE_SET((childpid > 0) ? argflags : -1);
+# endif
SETi(childpid);
RETURN;
#else
}
PerlProc__exit(-1);
#else /* ! FORK or VMS or OS/2 */
+ PL_statusvalue = 0;
+ result = 0;
if (PL_op->op_flags & OPf_STACKED) {
SV *really = *++MARK;
value = (I32)do_aspawn(really, (void **)MARK, (void **)SP);
else {
value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), n_a));
}
+ if (PL_statusvalue == -1) /* hint that value must be returned as is */
+ result = 1;
STATUS_NATIVE_SET(value);
do_execfree();
SP = ORIGMARK;
- PUSHi(STATUS_CURRENT);
+ PUSHi(result ? value : STATUS_CURRENT);
#endif /* !FORK or VMS */
RETURN;
}
projects / p5sagit/p5-mst-13.2.git / blobdiff