summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--embed.fnc2
-rw-r--r--embed.h2
-rw-r--r--op.c14
-rw-r--r--perly.act2
-rw-r--r--perly.y2
-rw-r--r--proto.h2
-rw-r--r--toke.c10
7 files changed, 22 insertions, 12 deletions
diff --git a/embed.fnc b/embed.fnc
index 6c0b1e8581..b1959d3376 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -221,7 +221,7 @@ p |I32 |do_trans |NN SV* sv
p |UV |do_vecget |NN SV* sv|I32 offset|I32 size
p |void |do_vecset |NN SV* sv
p |void |do_vop |I32 optype|NN SV* sv|NN SV* left|NN SV* right
-p |OP* |dofile |NN OP* term
+p |OP* |dofile |NN OP* term|I32 force_builtin
ApR |I32 |dowantarray
Ap |void |dump_all
Ap |void |dump_eval
diff --git a/embed.h b/embed.h
index 0cd11e6428..154d7e264f 100644
--- a/embed.h
+++ b/embed.h
@@ -2211,7 +2211,7 @@
#define do_vecget(a,b,c) Perl_do_vecget(aTHX_ a,b,c)
#define do_vecset(a) Perl_do_vecset(aTHX_ a)
#define do_vop(a,b,c,d) Perl_do_vop(aTHX_ a,b,c,d)
-#define dofile(a) Perl_dofile(aTHX_ a)
+#define dofile(a,b) Perl_dofile(aTHX_ a,b)
#endif
#define dowantarray() Perl_dowantarray(aTHX)
#define dump_all() Perl_dump_all(aTHX)
diff --git a/op.c b/op.c
index 275e9fd78d..6500d49ef4 100644
--- a/op.c
+++ b/op.c
@@ -3187,14 +3187,18 @@ Perl_vload_module(pTHX_ U32 flags, SV *name, SV *ver, va_list *args)
}
OP *
-Perl_dofile(pTHX_ OP *term)
+Perl_dofile(pTHX_ OP *term, I32 force_builtin)
{
OP *doop;
- GV *gv;
+ GV *gv = Nullgv;
- gv = gv_fetchpv("do", FALSE, SVt_PVCV);
- if (!(gv && GvCVu(gv) && GvIMPORTED_CV(gv)))
- gv = gv_fetchpv("CORE::GLOBAL::do", FALSE, SVt_PVCV);
+ if (!force_builtin) {
+ gv = gv_fetchpv("do", FALSE, SVt_PVCV);
+ if (!(gv && GvCVu(gv) && GvIMPORTED_CV(gv))) {
+ GV **gvp = (GV**)hv_fetch(PL_globalstash, "do", 2, FALSE);
+ if (gvp) gv = *gvp; else gv = Nullgv;
+ }
+ }
if (gv && GvCVu(gv) && GvIMPORTED_CV(gv)) {
doop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED,
diff --git a/perly.act b/perly.act
index 05269e28e5..243dfcb1b3 100644
--- a/perly.act
+++ b/perly.act
@@ -707,7 +707,7 @@ case 2:
case 133:
#line 569 "perly.y"
- { (yyval.opval) = dofile((yyvsp[0].opval)); ;}
+ { (yyval.opval) = dofile((yyvsp[0].opval), (yyvsp[-1].ival)); ;}
break;
case 134:
diff --git a/perly.y b/perly.y
index e88add1af6..1d20b04ce0 100644
--- a/perly.y
+++ b/perly.y
@@ -566,7 +566,7 @@ anonymous: '[' expr ']'
/* Things called with "do" */
termdo : DO term %prec UNIOP /* do $filename */
- { $$ = dofile($2); }
+ { $$ = dofile($2, $1); }
| DO block %prec '(' /* do { code */
{ $$ = newUNOP(OP_NULL, OPf_SPECIAL, scope($2)); }
| DO WORD '(' ')' /* do somesub() */
diff --git a/proto.h b/proto.h
index 0fbe1dfa42..64fa28a530 100644
--- a/proto.h
+++ b/proto.h
@@ -445,7 +445,7 @@ PERL_CALLCONV void Perl_do_vop(pTHX_ I32 optype, SV* sv, SV* left, SV* right)
__attribute__nonnull__(pTHX_3)
__attribute__nonnull__(pTHX_4);
-PERL_CALLCONV OP* Perl_dofile(pTHX_ OP* term)
+PERL_CALLCONV OP* Perl_dofile(pTHX_ OP* term, I32 force_builtin)
__attribute__nonnull__(pTHX_1);
PERL_CALLCONV I32 Perl_dowantarray(pTHX)
diff --git a/toke.c b/toke.c
index 93623f6740..998e7a1195 100644
--- a/toke.c
+++ b/toke.c
@@ -4520,9 +4520,9 @@ Perl_yylex(pTHX)
Perl_croak(aTHX_ "CORE::%s is not a keyword", PL_tokenbuf);
if (tmp < 0)
tmp = -tmp;
- else if (tmp == KEY_require)
+ else if (tmp == KEY_require || tmp == KEY_do)
/* that's a way to remember we saw "CORE::" */
- orig_keyword = KEY_require;
+ orig_keyword = tmp;
goto reserved_word;
}
goto just_a_word;
@@ -4606,6 +4606,12 @@ Perl_yylex(pTHX)
PRETERMBLOCK(DO);
if (*s != '\'')
s = force_word(s,WORD,TRUE,TRUE,FALSE);
+ if (orig_keyword == KEY_do) {
+ orig_keyword = 0;
+ yylval.ival = 1;
+ }
+ else
+ yylval.ival = 0;
OPERATOR(DO);
case KEY_die:
View Lorry Controller Status