PerlLIO_close(p[This]);
p[This] = p[that];
}
+ LOCK_FDPID_MUTEX;
sv = *av_fetch(PL_fdpid,p[This],TRUE);
+ UNLOCK_FDPID_MUTEX;
(void)SvUPGRADE(sv,SVt_IV);
SvIVX(sv) = pid;
PL_forkprocess = pid;
int saved_win32_errno;
#endif
+ LOCK_FDPID_MUTEX;
svp = av_fetch(PL_fdpid,PerlIO_fileno(ptr),TRUE);
+ UNLOCK_FDPID_MUTEX;
pid = SvIVX(*svp);
SvREFCNT_dec(*svp);
*svp = &PL_sv_undef;
}
SV *
-Perl_lock(pTHX_ SV *osv)
+Perl_sv_lock(pTHX_ SV *osv)
{
-#ifdef USE_THREADS
MAGIC *mg;
SV *sv = osv;
- SvLOCK(osv);
+ LOCK_SV_LOCK_MUTEX;
if (SvROK(sv)) {
sv = SvRV(sv);
- SvUNLOCK(osv);
- SvLOCK(sv);
}
mg = condpair_magic(sv);
MUTEX_LOCK(MgMUTEXP(mg));
if (MgOWNER(mg) == thr)
MUTEX_UNLOCK(MgMUTEXP(mg));
- else {
+ else {
while (MgOWNER(mg))
COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
MgOWNER(mg) = thr;
- DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%"UVxf": pp_lock lock 0x%"UVxf"\n",
+ DEBUG_S(PerlIO_printf(Perl_debug_log,
+ "0x%"UVxf": Perl_lock lock 0x%"UVxf"\n",
PTR2UV(thr), PTR2UV(sv));)
MUTEX_UNLOCK(MgMUTEXP(mg));
SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv);
}
-#endif
- SvUNLOCK(sv);
- return sv;
+ UNLOCK_SV_LOCK_MUTEX;
+ return sv;
}
/*
}
void
-Perl_report_closed_fh(pTHX_ GV *gv, IO *io, const char *func, const char *obj)
-{
- SV *sv;
- char *name;
-
- assert(gv);
-
- sv = sv_newmortal();
- gv_efullname3(sv, gv, Nullch);
- name = SvPVX(sv);
+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 */
+ PL_op_desc[op];
+ char *pars = OP_IS_FILETEST(op) ? "" : "()";
+ char *type = OP_IS_SOCKET(op) || (io && IoTYPE(io) == IoTYPE_SOCKET) ?
+ "socket" : "filehandle";
+ char *name = NULL;
+
+ if (io && IoTYPE(io) == IoTYPE_CLOSED) {
+ vile = "closed";
+ warn_type = WARN_CLOSED;
+ }
+ else {
+ vile = "unopened";
+ warn_type = WARN_UNOPENED;
+ }
- Perl_warner(aTHX_ WARN_CLOSED, "%s() on closed %s %s", func, obj, name);
+ if (gv && isGV(gv)) {
+ SV *sv = sv_newmortal();
+ gv_efullname4(sv, gv, Nullch, FALSE);
+ name = SvPVX(sv);
+ }
- if (io && IoDIRP(io))
- Perl_warner(aTHX_ WARN_CLOSED,
- "\t(Are you trying to call %s() on dirhandle %s?)\n",
- func, name);
+ if (name && *name) {
+ Perl_warner(aTHX_ 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_ warn_type,
+ "\t(Are you trying to call %s%s on dirhandle %s?)\n",
+ func, pars, name);
+ }
+ else {
+ Perl_warner(aTHX_ warn_type,
+ "%s%s on %s %s", func, pars, vile, type);
+ if (io && IoDIRP(io) && !(IoFLAGS(io) & IOf_FAKE_DIRP))
+ Perl_warner(aTHX_ warn_type,
+ "\t(Are you trying to call %s%s on dirhandle?)\n",
+ func, pars);
+ }
}