Put common override code into gv_override

When I moved the three occurrences of this code in op.c into a static
function, I did not realise at the time that it also occurred thre
etimes in toke.c.

So now it is in a new non-static function in gv.c.

Only two of the instances in toke.c could be changed to use this func-
tion, as the otherwise is a little different.  I couldn’t see a simple
way of factoring its requirements in.

diff --git a/embed.fnc b/embed.fnc
index 7d50d0b..9fed8b4 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -514,6 +514,8 @@ Ap  |void   |gv_init_pv     |NN GV* gv|NULLOK HV* stash|NN const char* name \
 Ap     |void   |gv_init_pvn    |NN GV* gv|NULLOK HV* stash|NN const char* name \
                                 |STRLEN len|U32 flags
 Ap     |void   |gv_name_set    |NN GV* gv|NN const char *name|U32 len|U32 flags
+px     |GV *   |gv_override    |NN const char * const name \
+                               |const STRLEN len
 XMpd   |void   |gv_try_downgrade|NN GV* gv
 Apd    |HV*    |gv_stashpv     |NN const char* name|I32 flags
 Apd    |HV*    |gv_stashpvn    |NN const char* name|U32 namelen|I32 flags

diff --git a/embed.h b/embed.h
index eb94543..a172226 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1119,6 +1119,7 @@
 #define get_hash_seed(a)       Perl_get_hash_seed(aTHX_ a)
 #define get_no_modify()                Perl_get_no_modify(aTHX)
 #define get_opargs()           Perl_get_opargs(aTHX)
+#define gv_override(a,b)       Perl_gv_override(aTHX_ a,b)
 #define gv_try_downgrade(a)    Perl_gv_try_downgrade(aTHX_ a)
 #define hv_ename_add(a,b,c,d)  Perl_hv_ename_add(aTHX_ a,b,c,d)
 #define hv_ename_delete(a,b,c,d)       Perl_hv_ename_delete(aTHX_ a,b,c,d)

diff --git a/gv.c b/gv.c
index 97036bc..08aaf9a 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -3366,6 +3366,23 @@ Perl_gv_try_downgrade(pTHX_ GV *gv)
     }
 }
 
+GV *
+Perl_gv_override(pTHX_ const char * const name, const STRLEN len)
+{
+    GV *gv = gv_fetchpvn(name, len, GV_NOTQUAL, SVt_PVCV);
+    GV * const *gvp;
+    PERL_ARGS_ASSERT_GV_OVERRIDE;
+    if (gv && GvCVu(gv) && GvIMPORTED_CV(gv)) return gv;
+    gvp = (GV**)hv_fetch(PL_globalstash, name, len, FALSE);
+    gv = gvp ? *gvp : NULL;
+    if (gv && !isGV(gv)) {
+       if (!SvPCS_IMPORTED(gv)) return NULL;
+       gv_init(gv, PL_globalstash, name, len, 0);
+       return gv;
+    }
+    return gv && GvCVu(gv) && GvIMPORTED_CV(gv) ? gv : NULL;
+}
+
 #include "XSUB.h"
 
 static void

diff --git a/op.c b/op.c
index 111da3c..12722dd 100644 (file)
--- a/op.c
+++ b/op.c
@@ -5464,22 +5464,6 @@ Perl_vload_module(pTHX_ U32 flags, SV *name, SV *ver, va_list *args)
     LEAVE;
 }
 
-GV *
-S_override(pTHX_ const char * const name, const STRLEN len)
-{
-    GV *gv = gv_fetchpvn(name, len, GV_NOTQUAL, SVt_PVCV);
-    GV * const *gvp;
-    if (gv && GvCVu(gv) && GvIMPORTED_CV(gv)) return gv;
-    gvp = (GV**)hv_fetch(PL_globalstash, name, len, FALSE);
-    gv = gvp ? *gvp : NULL;
-    if (gv && !isGV(gv)) {
-       if (!SvPCS_IMPORTED(gv)) return NULL;
-       gv_init(gv, PL_globalstash, name, len, 0);
-       return gv;
-    }
-    return gv && GvCVu(gv) && GvIMPORTED_CV(gv) ? gv : NULL;
-}
-
 OP *
 Perl_dofile(pTHX_ OP *term, I32 force_builtin)
 {
@@ -5489,7 +5473,7 @@ Perl_dofile(pTHX_ OP *term, I32 force_builtin)
 
     PERL_ARGS_ASSERT_DOFILE;
 
-    if (!force_builtin && (gv = S_override(aTHX_ "do", 2))) {
+    if (!force_builtin && (gv = gv_override("do", 2))) {
        doop = newUNOP(OP_ENTERSUB, OPf_STACKED,
                               op_append_elem(OP_LIST, term,
                                           scalar(newUNOP(OP_RV2CV, 0,
@@ -9224,7 +9208,7 @@ Perl_ck_glob(pTHX_ OP *o)
     if ((o->op_flags & OPf_KIDS) && !cLISTOPo->op_first->op_sibling)
        op_append_elem(OP_GLOB, o, newDEFSVOP()); /* glob() => glob($_) */
 
-    if (!(o->op_flags & OPf_SPECIAL) && (gv = S_override(aTHX_ "glob", 4)))
+    if (!(o->op_flags & OPf_SPECIAL) && (gv = gv_override("glob", 4)))
     {
        /* convert
         *     glob
@@ -9737,7 +9721,7 @@ Perl_ck_require(pTHX_ OP *o)
 
     if (!(o->op_flags & OPf_SPECIAL) /* Wasn't written as CORE::require */
        /* handle override, if any */
-     && (gv = S_override(aTHX_ "require", 7))) {
+     && (gv = gv_override("require", 7))) {
        OP *kid, *newop;
        if (o->op_flags & OPf_KIDS) {
            kid = cUNOPo->op_first;

diff --git a/proto.h b/proto.h
index 07729d2..2d4b155 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1488,6 +1488,11 @@ PERL_CALLCONV void       Perl_gv_name_set(pTHX_ GV* gv, const char *name, U32 len, U32
 #define PERL_ARGS_ASSERT_GV_NAME_SET   \
        assert(gv); assert(name)
 
+PERL_CALLCONV GV *     Perl_gv_override(pTHX_ const char * const name, const STRLEN len)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_GV_OVERRIDE   \
+       assert(name)
+
 PERL_CALLCONV HV*      Perl_gv_stashpv(pTHX_ const char* name, I32 flags)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_GV_STASHPV    \

diff --git a/toke.c b/toke.c
index 63f7990..c19b446 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -4483,17 +4483,7 @@ S_readpipe_override(pTHX)
     GV **gvp;
     GV *gv_readpipe = gv_fetchpvs("readpipe", GV_NOTQUAL, SVt_PVCV);
     pl_yylval.ival = OP_BACKTICK;
-    if ((gv_readpipe
-               && GvCVu(gv_readpipe) && GvIMPORTED_CV(gv_readpipe))
-           ||
-           ((gvp = (GV**)hv_fetchs(PL_globalstash, "readpipe", FALSE))
-            && (gv_readpipe = *gvp) && (
-               isGV_with_GP(gv_readpipe)
-                   ? GvCVu(gv_readpipe) && GvIMPORTED_CV(gv_readpipe)
-                   :   SvPCS_IMPORTED(gv_readpipe)
-                    && (gv_init(gv_readpipe, PL_globalstash, "readpipe",
-                                8, 0), 1)
-            )))
+    if ((gv_readpipe = gv_override("readpipe",8)))
     {
        COPLINE_SET_FROM_MULTI_END;
        PL_lex_op = (OP*)newUNOP(OP_ENTERSUB, OPf_STACKED,
@@ -10431,17 +10421,7 @@ S_scan_inputsymbol(pTHX_ char *start)
 
        /* Check whether readline() is overriden */
        gv_readline = gv_fetchpvs("readline", GV_NOTQUAL, SVt_PVCV);
-       if ((gv_readline
-               && GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline))
-               ||
-               ((gvp = (GV**)hv_fetchs(PL_globalstash, "readline", FALSE))
-                && (gv_readline = *gvp) && (
-                   isGV_with_GP(gv_readline)
-                       ? GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline)
-                       :   SvPCS_IMPORTED(gv_readline)
-                        && (gv_init(gv_readline, PL_globalstash,
-                                   "readline", 8, 0), 1)
-               )))
+       if ((gv_readline = gv_override("readline",8)))
            readline_overriden = TRUE;
 
        /* if <$fh>, create the ops to turn the variable into a