From: Gurusamy Sarathy <gsar@cpan.org>
Date: Sat, 3 Oct 1998 05:19:56 +0000 (+0000)
Subject: make C<use> recognize C<require> overrides; allow C<do EXPR> to be
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=78ca652eaf12f3ab6d7714883eec614d257f666a;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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"