PerlIO *serr = Perl_error_log;
PerlIO_write(serr, message, msglen);
#ifdef LEAKTEST
- DEBUG_L(xstat());
+ DEBUG_L(*message == '!'
+ ? (xstat(message[1]=='!'
+ ? (message[2]=='!' ? 2 : 1)
+ : 0)
+ , 0)
+ : 0);
#endif
(void)PerlIO_flush(serr);
}
if (!pid)
return -1;
+#if !defined(HAS_WAITPID) && !defined(HAS_WAIT4) || defined(HAS_WAITPID_RUNTIME)
if (pid > 0) {
sprintf(spid, "%"IVdf, (IV)pid);
svp = hv_fetch(PL_pidstatus,spid,strlen(spid),FALSE);
return pid;
}
}
+#endif
#ifdef HAS_WAITPID
# ifdef HAS_WAITPID_RUNTIME
if (!HAS_WAITPID_RUNTIME)
NV
Perl_my_atof(pTHX_ const char* s)
{
+ NV x = 0.0;
#ifdef USE_LOCALE_NUMERIC
if ((PL_hints & HINT_LOCALE) && PL_numeric_local) {
- NV x, y;
+ NV y;
- x = Perl_atof(s);
+ Perl_atof2(s, x);
SET_NUMERIC_STANDARD();
- y = Perl_atof(s);
+ Perl_atof2(s, y);
SET_NUMERIC_LOCAL();
if ((y < 0.0 && y < x) || (y > 0.0 && y > x))
return y;
- return x;
}
else
- return Perl_atof(s);
+ Perl_atof2(s, x);
#else
- return Perl_atof(s);
+ Perl_atof2(s, x);
#endif
+ return x;
}
void
Perl_report_evil_fh(pTHX_ GV *gv, IO *io, I32 op)
{
char *vile;
- I32 warn;
+ I32 warn_type;
char *func =
- op == OP_READLINE ? "readline" :
- op == OP_LEAVEWRITE ? "write" :
+ 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 (isGV(gv)) {
- SV *sv = sv_newmortal();
- gv_efullname4(sv, gv, Nullch, FALSE);
- name = SvPVX(sv);
- }
-
if (io && IoTYPE(io) == IoTYPE_CLOSED) {
vile = "closed";
- warn = WARN_CLOSED;
+ warn_type = WARN_CLOSED;
}
else {
vile = "unopened";
- warn = WARN_UNOPENED;
+ warn_type = WARN_UNOPENED;
+ }
+
+ if (gv && isGV(gv)) {
+ SV *sv = sv_newmortal();
+ gv_efullname4(sv, gv, Nullch, FALSE);
+ name = SvPVX(sv);
}
if (name && *name) {
- Perl_warner(aTHX_ warn,
+ Perl_warner(aTHX_ warn_type,
"%s%s on %s %s %s", func, pars, vile, type, name);
- if (io && IoDIRP(io))
- Perl_warner(aTHX_ warn,
+ 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,
+ Perl_warner(aTHX_ warn_type,
"%s%s on %s %s", func, pars, vile, type);
- if (io && IoDIRP(io))
- Perl_warner(aTHX_ warn,
+ 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);
}