CORE::GLOBAL::require override happens too early

Message-ID: <lrofsjfym1.fsf@caliper.ActiveState.com>

p4raw-id: //depot/perl@10192

diff --git a/op.c b/op.c
index 61f4850..a252a02 100644 (file)
--- a/op.c
+++ b/op.c
@@ -3192,7 +3192,6 @@ void
 Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
 {
     OP *pack;
-    OP *rqop;
     OP *imop;
     OP *veop;
     GV *gv;
@@ -3253,22 +3252,6 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
                                   newSVOP(OP_METHOD_NAMED, 0, meth)));
     }
 
-    /* Fake up a require, handle override, if any */
-    gv = gv_fetchpv("require", FALSE, SVt_PVCV);
-    if (!(gv && GvIMPORTED_CV(gv)))
-       gv = gv_fetchpv("CORE::GLOBAL::require", FALSE, SVt_PVCV);
-
-    if (gv && GvIMPORTED_CV(gv)) {
-       rqop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED,
-                              append_elem(OP_LIST, id,
-                                          scalar(newUNOP(OP_RV2CV, 0,
-                                                         newGVOP(OP_GV, 0,
-                                                                 gv))))));
-    }
-    else {
-       rqop = newUNOP(OP_REQUIRE, 0, id);
-    }
-
     /* Fake up the BEGIN {}, which does its thing immediately. */
     newATTRSUB(floor,
        newSVOP(OP_CONST, 0, newSVpvn("BEGIN", 5)),
@@ -3276,7 +3259,7 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
        Nullop,
        append_elem(OP_LINESEQ,
            append_elem(OP_LINESEQ,
-               newSTATEOP(0, Nullch, rqop),
+               newSTATEOP(0, Nullch, newUNOP(OP_REQUIRE, 0, id)),
                newSTATEOP(0, Nullch, veop)),
            newSTATEOP(0, Nullch, imop) ));
 
@@ -6186,6 +6169,8 @@ Perl_ck_repeat(pTHX_ OP *o)
 OP *
 Perl_ck_require(pTHX_ OP *o)
 {
+    GV* gv;
+
     if (o->op_flags & OPf_KIDS) {      /* Shall we supply missing .pm? */
        SVOP *kid = (SVOP*)cUNOPo->op_first;
 
@@ -6207,6 +6192,23 @@ Perl_ck_require(pTHX_ OP *o)
                sv_catpvn(kid->op_sv, ".pm", 3);
        }
     }
+
+    /* handle override, if any */
+    gv = gv_fetchpv("require", FALSE, SVt_PVCV);
+    if (!(gv && GvIMPORTED_CV(gv)))
+       gv = gv_fetchpv("CORE::GLOBAL::require", FALSE, SVt_PVCV);
+
+    if (gv && GvIMPORTED_CV(gv)) {
+       OP *kid = cUNOPo->op_first;
+       cUNOPo->op_first = 0;
+       op_free(o);
+       return ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED,
+                              append_elem(OP_LIST, kid,
+                                          scalar(newUNOP(OP_RV2CV, 0,
+                                                         newGVOP(OP_GV, 0,
+                                                                 gv))))));
+    }
+
     return ck_fun(o);
 }
 

diff --git a/toke.c b/toke.c
index fe4069a..64b5d80 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -5629,7 +5629,7 @@ Perl_keyword(pTHX_ register char *d, I32 len)
            if (strEQ(d,"rindex"))              return -KEY_rindex;
            break;
        case 7:
-           if (strEQ(d,"require"))             return -KEY_require;
+           if (strEQ(d,"require"))             return KEY_require;
            if (strEQ(d,"reverse"))             return -KEY_reverse;
            if (strEQ(d,"readdir"))             return -KEY_readdir;
            break;