while ((pid = PerlProc_fork()) < 0) {
if (errno != EAGAIN) {
PerlLIO_close(p[This]);
+ PerlLIO_close(p[that]);
if (did_pipes) {
PerlLIO_close(pp[0]);
PerlLIO_close(pp[1]);
#undef THAT
#define THIS that
#define THAT This
- /* Close parent's end of _the_ pipe */
- PerlLIO_close(p[THAT]);
/* Close parent's end of error status pipe (if any) */
if (did_pipes) {
PerlLIO_close(pp[0]);
if (p[THIS] != (*mode == 'r')) {
PerlLIO_dup2(p[THIS], *mode == 'r');
PerlLIO_close(p[THIS]);
+ if (p[THAT] != (*mode == 'r')) /* if dup2() didn't close it */
+ PerlLIO_close(p[THAT]); /* close parent's end of _the_ pipe */
}
+ else
+ PerlLIO_close(p[THAT]); /* close parent's end of _the_ pipe */
#if !defined(HAS_FCNTL) || !defined(F_SETFD)
/* No automatic close - do it by hand */
# ifndef NOFILE
}
/* Parent */
do_execfree(); /* free any memory malloced by child on fork */
- /* Close child's end of pipe */
- PerlLIO_close(p[that]);
if (did_pipes)
PerlLIO_close(pp[1]);
/* Keep the lower of the two fd numbers */
PerlLIO_close(p[This]);
p[This] = p[that];
}
+ else
+ PerlLIO_close(p[that]); /* close child's end of pipe */
+
LOCK_FDPID_MUTEX;
sv = *av_fetch(PL_fdpid,p[This],TRUE);
UNLOCK_FDPID_MUTEX;
{
struct sigaction act, oact;
+#ifdef USE_ITHREADS
+ /* only "parent" interpreter can diddle signals */
+ if (PL_curinterp != aTHX)
+ return SIG_ERR;
+#endif
+
act.sa_handler = handler;
sigemptyset(&act.sa_mask);
act.sa_flags = 0;
{
struct sigaction act;
+#ifdef USE_ITHREADS
+ /* only "parent" interpreter can diddle signals */
+ if (PL_curinterp != aTHX)
+ return -1;
+#endif
+
act.sa_handler = handler;
sigemptyset(&act.sa_mask);
act.sa_flags = 0;
int
Perl_rsignal_restore(pTHX_ int signo, Sigsave_t *save)
{
+#ifdef USE_ITHREADS
+ /* only "parent" interpreter can diddle signals */
+ if (PL_curinterp != aTHX)
+ return -1;
+#endif
+
return sigaction(signo, save, (struct sigaction *)NULL);
}
Sighandler_t
Perl_rsignal(pTHX_ int signo, Sighandler_t handler)
{
+#if defined(USE_ITHREADS) && !defined(WIN32)
+ /* only "parent" interpreter can diddle signals */
+ if (PL_curinterp != aTHX)
+ return SIG_ERR;
+#endif
+
return PerlProc_signal(signo, handler);
}
{
Sighandler_t oldsig;
+#if defined(USE_ITHREADS) && !defined(WIN32)
+ /* only "parent" interpreter can diddle signals */
+ if (PL_curinterp != aTHX)
+ return SIG_ERR;
+#endif
+
sig_trapped = 0;
oldsig = PerlProc_signal(signo, sig_trap);
PerlProc_signal(signo, oldsig);
int
Perl_rsignal_save(pTHX_ int signo, Sighandler_t handler, Sigsave_t *save)
{
+#if defined(USE_ITHREADS) && !defined(WIN32)
+ /* only "parent" interpreter can diddle signals */
+ if (PL_curinterp != aTHX)
+ return -1;
+#endif
*save = PerlProc_signal(signo, handler);
return (*save == SIG_ERR) ? -1 : 0;
}
int
Perl_rsignal_restore(pTHX_ int signo, Sigsave_t *save)
{
+#if defined(USE_ITHREADS) && !defined(WIN32)
+ /* only "parent" interpreter can diddle signals */
+ if (PL_curinterp != aTHX)
+ return -1;
+#endif
return (PerlProc_signal(signo, *save) == SIG_ERR) ? -1 : 0;
}
return PerlIO_flush(NULL);
#else
# if defined(HAS__FWALK)
+ extern int fflush(FILE *);
/* undocumented, unprototyped, but very useful BSDism */
extern void _fwalk(int (*)(FILE *));
_fwalk(&fflush);
void
Perl_report_evil_fh(pTHX_ GV *gv, IO *io, I32 op)
{
- char *vile;
- I32 warn_type;
char *func =
op == OP_READLINE ? "readline" : /* "<HANDLE>" not nice */
op == OP_LEAVEWRITE ? "write" : /* "write exit" not nice */
"socket" : "filehandle";
char *name = NULL;
- if (gv && io && IoTYPE(io) == IoTYPE_CLOSED) {
- vile = "closed";
- warn_type = WARN_CLOSED;
- }
- else {
- vile = "unopened";
- warn_type = WARN_UNOPENED;
- }
-
if (gv && isGV(gv)) {
name = GvENAME(gv);
}
if (op == OP_phoney_OUTPUT_ONLY || op == OP_phoney_INPUT_ONLY) {
- if (name && *name)
- Perl_warner(aTHX_ packWARN(WARN_IO), "Filehandle %s opened only for %sput",
- name,
- (op == OP_phoney_INPUT_ONLY ? "in" : "out"));
- else
- Perl_warner(aTHX_ packWARN(WARN_IO), "Filehandle opened only for %sput",
- (op == OP_phoney_INPUT_ONLY ? "in" : "out"));
- } else if (name && *name) {
- Perl_warner(aTHX_ packWARN(warn_type),
- "%s%s on %s %s %s", func, pars, vile, type, name);
- if (io && IoDIRP(io) && !(IoFLAGS(io) & IOf_FAKE_DIRP))
- Perl_warner(aTHX_ packWARN(warn_type),
- "\t(Are you trying to call %s%s on dirhandle %s?)\n",
- func, pars, name);
+ if (ckWARN(WARN_IO)) {
+ if (name && *name)
+ Perl_warner(aTHX_ packWARN(WARN_IO),
+ "Filehandle %s opened only for %sput",
+ name, (op == OP_phoney_INPUT_ONLY ? "in" : "out"));
+ else
+ Perl_warner(aTHX_ packWARN(WARN_IO),
+ "Filehandle opened only for %sput",
+ (op == OP_phoney_INPUT_ONLY ? "in" : "out"));
+ }
}
else {
- Perl_warner(aTHX_ packWARN(warn_type),
- "%s%s on %s %s", func, pars, vile, type);
- if (gv && io && IoDIRP(io) && !(IoFLAGS(io) & IOf_FAKE_DIRP))
- Perl_warner(aTHX_ packWARN(warn_type),
- "\t(Are you trying to call %s%s on dirhandle?)\n",
- func, pars);
+ char *vile;
+ I32 warn_type;
+
+ if (gv && io && IoTYPE(io) == IoTYPE_CLOSED) {
+ vile = "closed";
+ warn_type = WARN_CLOSED;
+ }
+ else {
+ vile = "unopened";
+ warn_type = WARN_UNOPENED;
+ }
+
+ if (ckWARN(warn_type)) {
+ if (name && *name) {
+ Perl_warner(aTHX_ packWARN(warn_type),
+ "%s%s on %s %s %s", func, pars, vile, type, name);
+ if (io && IoDIRP(io) && !(IoFLAGS(io) & IOf_FAKE_DIRP))
+ Perl_warner(aTHX_ packWARN(warn_type),
+ "\t(Are you trying to call %s%s on dirhandle %s?)\n",
+ func, pars, name);
+ }
+ else {
+ Perl_warner(aTHX_ packWARN(warn_type),
+ "%s%s on %s %s", func, pars, vile, type);
+ if (gv && io && IoDIRP(io) && !(IoFLAGS(io) & IOf_FAKE_DIRP))
+ Perl_warner(aTHX_ packWARN(warn_type),
+ "\t(Are you trying to call %s%s on dirhandle?)\n",
+ func, pars);
+ }
+ }
}
}