summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doio.c2
-rw-r--r--embed.fnc2
-rw-r--r--embed.h1
-rw-r--r--pp_hot.c4
-rw-r--r--pp_sys.c8
-rw-r--r--proto.h1
-rw-r--r--util.c119
7 files changed, 71 insertions, 66 deletions
diff --git a/doio.c b/doio.c
index 526e1b5df6..1ab91f722c 100644
--- a/doio.c
+++ b/doio.c
@@ -997,7 +997,7 @@ Perl_do_eof(pTHX_ GV *gv)
if (!io)
return TRUE;
else if ((IoTYPE(io) == IoTYPE_WRONLY) && ckWARN(WARN_IO))
- report_evil_fh(gv, io, OP_phoney_OUTPUT_ONLY);
+ report_wrongway_fh(gv, '>');
while (IoIFP(io)) {
if (PerlIO_has_cntptr(IoIFP(io))) { /* (the code works without this) */
diff --git a/embed.fnc b/embed.fnc
index fd17107f93..bd9c7a8042 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1344,6 +1344,8 @@ Ap |U32 |seed
pR |UV |get_hash_seed
: Used in doio.c, pp_hot.c, pp_sys.c
p |void |report_evil_fh |NULLOK const GV *gv|NULLOK const IO *io|I32 op
+: Used in doio.c, pp_hot.c, pp_sys.c
+p |void |report_wrongway_fh|NULLOK const GV *gv|const char have
: Used in mg.c, pp.c, pp_hot.c, regcomp.c
XEpd |void |report_uninit |NULLOK const SV *uninit_sv
Apd |void |warn_sv |NN SV *baseex
diff --git a/embed.h b/embed.h
index de10dc2bbd..a8e8c0702d 100644
--- a/embed.h
+++ b/embed.h
@@ -1466,6 +1466,7 @@
#define refcounted_he_new_pvn(a,b,c,d,e,f) Perl_refcounted_he_new_pvn(aTHX_ a,b,c,d,e,f)
#define refcounted_he_new_sv(a,b,c,d,e) Perl_refcounted_he_new_sv(aTHX_ a,b,c,d,e)
#define report_evil_fh(a,b,c) Perl_report_evil_fh(aTHX_ a,b,c)
+#define report_wrongway_fh(a,b) Perl_report_wrongway_fh(aTHX_ a,b)
#define rpeep(a) Perl_rpeep(aTHX_ a)
#define rsignal_restore(a,b) Perl_rsignal_restore(aTHX_ a,b)
#define rsignal_save(a,b,c) Perl_rsignal_save(aTHX_ a,b,c)
diff --git a/pp_hot.c b/pp_hot.c
index 9bc7eaeed1..645c7d2a6b 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -758,7 +758,7 @@ PP(pp_print)
else if (!(fp = IoOFP(io))) {
if (ckWARN2(WARN_CLOSED, WARN_IO)) {
if (IoIFP(io))
- report_evil_fh(gv, io, OP_phoney_INPUT_ONLY);
+ report_wrongway_fh(gv, '<');
else if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
}
@@ -1625,7 +1625,7 @@ Perl_do_readline(pTHX)
else if (type == OP_GLOB)
SP--;
else if (ckWARN(WARN_IO) && IoTYPE(io) == IoTYPE_WRONLY) {
- report_evil_fh(PL_last_in_gv, io, OP_phoney_OUTPUT_ONLY);
+ report_wrongway_fh(PL_last_in_gv, '>');
}
}
if (!fp) {
diff --git a/pp_sys.c b/pp_sys.c
index 0d382edac7..059fb03e11 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1451,7 +1451,7 @@ PP(pp_leavewrite)
if (!fp) {
if (ckWARN2(WARN_CLOSED,WARN_IO)) {
if (IoIFP(io))
- report_evil_fh(gv, io, OP_phoney_INPUT_ONLY);
+ report_wrongway_fh(gv, '<');
else if (ckWARN(WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
}
@@ -1519,7 +1519,7 @@ PP(pp_prtf)
else if (!(fp = IoOFP(io))) {
if (ckWARN2(WARN_CLOSED,WARN_IO)) {
if (IoIFP(io))
- report_evil_fh(gv, io, OP_phoney_INPUT_ONLY);
+ report_wrongway_fh(gv, '<');
else if (ckWARN(WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
}
@@ -1764,7 +1764,7 @@ PP(pp_sysread)
}
if (count < 0) {
if ((IoTYPE(io) == IoTYPE_WRONLY) && ckWARN(WARN_IO))
- report_evil_fh(gv, io, OP_phoney_OUTPUT_ONLY);
+ report_wrongway_fh(gv, '>');
goto say_undef;
}
SvCUR_set(read_target, count+(buffer - SvPVX_const(read_target)));
@@ -1866,7 +1866,7 @@ PP(pp_send)
retval = -1;
if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) {
if (io && IoIFP(io))
- report_evil_fh(gv, io, OP_phoney_INPUT_ONLY);
+ report_wrongway_fh(gv, '<');
else
report_evil_fh(gv, io, PL_op->op_type);
}
diff --git a/proto.h b/proto.h
index 430367835b..fdf480affb 100644
--- a/proto.h
+++ b/proto.h
@@ -3481,6 +3481,7 @@ PERL_CALLCONV void Perl_repeatcpy(char* to, const char* from, I32 len, I32 count
PERL_CALLCONV void Perl_report_evil_fh(pTHX_ const GV *gv, const IO *io, I32 op);
PERL_CALLCONV void Perl_report_uninit(pTHX_ const SV *uninit_sv);
+PERL_CALLCONV void Perl_report_wrongway_fh(pTHX_ const GV *gv, const char have);
PERL_CALLCONV void Perl_require_pv(pTHX_ const char* pv)
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_REQUIRE_PV \
diff --git a/util.c b/util.c
index 02861f09e5..ff1e756852 100644
--- a/util.c
+++ b/util.c
@@ -3864,71 +3864,72 @@ Perl_my_fflush_all(pTHX)
}
void
+Perl_report_wrongway_fh(pTHX_ const GV *gv, char have)
+{
+ if (ckWARN(WARN_IO)) {
+ const char * const name
+ = gv && (isGV(gv) || isGV_with_GP(gv)) ? GvENAME(gv) : NULL;
+ const char * const direction = have == '>' ? "out" : "in";
+
+ if (name && *name)
+ Perl_warner(aTHX_ packWARN(WARN_IO),
+ "Filehandle %s opened only for %sput",
+ name, direction);
+ else
+ Perl_warner(aTHX_ packWARN(WARN_IO),
+ "Filehandle opened only for %sput", direction);
+ }
+}
+
+void
Perl_report_evil_fh(pTHX_ const GV *gv, const IO *io, I32 op)
{
- const char * const name
- = gv && (isGV(gv) || isGV_with_GP(gv)) ? GvENAME(gv) : NULL;
-
- if (op == OP_phoney_OUTPUT_ONLY || op == OP_phoney_INPUT_ONLY) {
- if (ckWARN(WARN_IO)) {
- const char * const direction =
- (const char *)((op == OP_phoney_INPUT_ONLY) ? "in" : "out");
- if (name && *name)
- Perl_warner(aTHX_ packWARN(WARN_IO),
- "Filehandle %s opened only for %sput",
- name, direction);
- else
- Perl_warner(aTHX_ packWARN(WARN_IO),
- "Filehandle opened only for %sput", direction);
- }
+ const char *vile;
+ I32 warn_type;
+
+ if (gv && io && IoTYPE(io) == IoTYPE_CLOSED) {
+ vile = "closed";
+ warn_type = WARN_CLOSED;
}
else {
- const char *vile;
- I32 warn_type;
-
- if (gv && io && IoTYPE(io) == IoTYPE_CLOSED) {
- vile = "closed";
- warn_type = WARN_CLOSED;
+ vile = "unopened";
+ warn_type = WARN_UNOPENED;
+ }
+
+ if (ckWARN(warn_type)) {
+ const char * const name
+ = gv && (isGV(gv) || isGV_with_GP(gv)) ? GvENAME(gv) : NULL;
+ const char * const pars =
+ (const char *)(OP_IS_FILETEST(op) ? "" : "()");
+ const char * const func =
+ (const char *)
+ (op == OP_READLINE ? "readline" : /* "<HANDLE>" not nice */
+ op == OP_LEAVEWRITE ? "write" : /* "write exit" not nice */
+ op < 0 ? "" : /* handle phoney cases */
+ PL_op_desc[op]);
+ const char * const type =
+ (const char *)
+ (OP_IS_SOCKET(op) || (gv && io && IoTYPE(io) == IoTYPE_SOCKET)
+ ? "socket" : "filehandle");
+ 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 {
- vile = "unopened";
- warn_type = WARN_UNOPENED;
- }
-
- if (ckWARN(warn_type)) {
- const char * const pars =
- (const char *)(OP_IS_FILETEST(op) ? "" : "()");
- const char * const func =
- (const char *)
- (op == OP_READLINE ? "readline" : /* "<HANDLE>" not nice */
- op == OP_LEAVEWRITE ? "write" : /* "write exit" not nice */
- op < 0 ? "" : /* handle phoney cases */
- PL_op_desc[op]);
- const char * const type =
- (const char *)
- (OP_IS_SOCKET(op) ||
- (gv && io && IoTYPE(io) == IoTYPE_SOCKET) ?
- "socket" : "filehandle");
- 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
- );
- }
+ 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
+ );
}
}
}
View Lorry Controller Status