Extract the OP_phoney_* code from report_evil_fh() into report_wrongway_fh()
authorNicholas Clark <nick@ccl4.org>
Tue, 28 Dec 2010 07:55:45 +0000 (07:55 +0000)
committerNicholas Clark <nick@ccl4.org>
Tue, 28 Dec 2010 08:35:37 +0000 (08:35 +0000)
Previously Perl_report_evil_fh()'s body was just an if/else at the top level -
a good sign that it is actually implementing two disjoint functions.

doio.c
embed.fnc
embed.h
pp_hot.c
pp_sys.c
proto.h
util.c

diff --git a/doio.c b/doio.c
index 526e1b5..1ab91f7 100644 (file)
--- 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) */
index fd17107..bd9c7a8 100644 (file)
--- 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 de10dc2..a8e8c07 100644 (file)
--- a/embed.h
+++ b/embed.h
 #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)
index 9bc7eae..645c7d2 100644 (file)
--- 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) {
index 0d382ed..059fb03 100644 (file)
--- 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 4303678..fdf480a 100644 (file)
--- 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 02861f0..ff1e756 100644 (file)
--- a/util.c
+++ b/util.c
@@ -3863,72 +3863,73 @@ Perl_my_fflush_all(pTHX)
 #endif
 }
 
+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
+                           );
        }
     }
 }