make C<use> recognize C<require> overrides; allow C<do EXPR> to be

overridden

p4raw-id: //depot/perl@1923

diff --git a/embed.h b/embed.h
index 376fb34..c2254a9 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -159,6 +159,7 @@
 #define do_trans               Perl_do_trans
 #define do_vecset              Perl_do_vecset
 #define do_vop                 Perl_do_vop
+#define dofile                 Perl_dofile
 #define dofindlabel            Perl_dofindlabel
 #define dopoptoeval            Perl_dopoptoeval
 #define dounwind               Perl_dounwind

diff --git a/global.sym b/global.sym
index 2536965..8dff0fc 100644 (file)
--- a/global.sym
+++ b/global.sym
@@ -270,6 +270,7 @@ do_tell
 do_trans
 do_vecset
 do_vop
+dofile
 dofindlabel
 dopoptoeval
 dounwind

diff --git a/objXSUB.h b/objXSUB.h
index c9a14be..463301e 100644 (file)
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -911,6 +911,8 @@
 #define do_vecset           pPerl->Perl_do_vecset
 #undef  do_vop
 #define do_vop              pPerl->Perl_do_vop
+#undef  dofile
+#define dofile              pPerl->Perl_dofile
 #undef  dowantarray
 #define dowantarray         pPerl->Perl_dowantarray
 #undef  dump_all

diff --git a/objpp.h b/objpp.h
index b1753c8..e19e366 100644 (file)
--- a/objpp.h
+++ b/objpp.h
@@ -299,6 +299,8 @@
 #define do_report_used    CPerlObj::do_report_used
 #undef  docatch
 #define docatch           CPerlObj::docatch
+#undef  dofile
+#define dofile            CPerlObj::Perl_dofile
 #undef  dowantarray
 #define dowantarray       CPerlObj::Perl_dowantarray
 #undef  dump

diff --git a/op.c b/op.c
index b6e2499..f8eb4a7 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2580,6 +2580,7 @@ utilize(int aver, I32 floor, OP *version, OP *id, OP *arg)
     OP *rqop;
     OP *imop;
     OP *veop;
+    GV *gv;
 
     if (id->op_type != OP_CONST)
        croak("Module name must be constant");
@@ -2631,8 +2632,21 @@ utilize(int aver, I32 floor, OP *version, OP *id, OP *arg)
                        newUNOP(OP_METHOD, 0, meth)));
     }
 
-    /* Fake up a require */
-    rqop = newUNOP(OP_REQUIRE, 0, id);
+    /* 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. */
     newSUB(floor,
@@ -2649,6 +2663,29 @@ utilize(int aver, I32 floor, OP *version, OP *id, OP *arg)
 }
 
 OP *
+dofile(OP *term)
+{
+    OP *doop;
+    GV *gv;
+
+    gv = gv_fetchpv("do", FALSE, SVt_PVCV);
+    if (!(gv && GvIMPORTED_CV(gv)))
+       gv = gv_fetchpv("CORE::GLOBAL::do", FALSE, SVt_PVCV);
+
+    if (gv && GvIMPORTED_CV(gv)) {
+       doop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED,
+                              append_elem(OP_LIST, term,
+                                          scalar(newUNOP(OP_RV2CV, 0,
+                                                         newGVOP(OP_GV, 0,
+                                                                 gv))))));
+    }
+    else {
+       doop = newUNOP(OP_DOFILE, 0, scalar(term));
+    }
+    return doop;
+}
+
+OP *
 newSLICEOP(I32 flags, OP *subscript, OP *listval)
 {
     return newBINOP(OP_LSLICE, flags,

diff --git a/perly.c b/perly.c
index f9799a8..eccfdd7 100644 (file)
--- a/perly.c
+++ b/perly.c
@@ -2110,7 +2110,7 @@ case 134:
 break;
 case 135:
 #line 515 "perly.y"
-{ yyval.opval = newUNOP(OP_DOFILE, 0, scalar(yyvsp[0].opval)); }
+{ yyval.opval = dofile(yyvsp[0].opval); }
 break;
 case 136:
 #line 517 "perly.y"

diff --git a/perly.y b/perly.y
index e016cf4..47e6324 100644 (file)
--- a/perly.y
+++ b/perly.y
@@ -512,7 +512,7 @@ term        :       term ASSIGNOP term
                        { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
                            append_elem(OP_LIST, $3, scalar($2))); }
        |       DO term %prec UNIOP
-                       { $$ = newUNOP(OP_DOFILE, 0, scalar($2)); }
+                       { $$ = dofile($2); }
        |       DO block        %prec '('
                        { $$ = newUNOP(OP_NULL, OPf_SPECIAL, scope($2)); }
        |       DO WORD '(' ')'

diff --git a/proto.h b/proto.h
index 75d44bd..e0befbd 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -129,6 +129,7 @@ VIRTUAL Off_t       do_tell _((GV* gv));
 VIRTUAL I32    do_trans _((SV* sv));
 VIRTUAL void   do_vecset _((SV* sv));
 VIRTUAL void   do_vop _((I32 optype, SV* sv, SV* left, SV* right));
+VIRTUAL OP*    dofile _((OP* term));
 VIRTUAL I32    dowantarray _((void));
 VIRTUAL void   dump_all _((void));
 VIRTUAL void   dump_eval _((void));

diff --git a/vms/perly_c.vms b/vms/perly_c.vms
index 1583f61..1ff29a4 100644 (file)
--- a/vms/perly_c.vms
+++ b/vms/perly_c.vms
@@ -2114,7 +2114,7 @@ case 134:
 break;
 case 135:
 #line 515 "perly.y"
-{ yyval.opval = newUNOP(OP_DOFILE, 0, scalar(yyvsp[0].opval)); }
+{ yyval.opval = dofile(yyvsp[0].opval); }
 break;
 case 136:
 #line 517 "perly.y"