In perl.git, the branch sprout/overridesβ has been updated <http://perl5.git.perl.org/perl.git/commitdiff/f39c5ccfaab6bfa0faf1b84731e327c38460dd16?hp=8fd2bd389ddbdd7b64ec55c97021b79d45d8db33>
- Log ----------------------------------------------------------------- commit f39c5ccfaab6bfa0faf1b84731e327c38460dd16 Author: Father Chrysostomos <[email protected]> Date: Sun Apr 29 00:11:10 2012 -0700 op.c:ck_require: Ignore sub prototype The require operator doesnât allow its syntax to be overridden. But it was still calling an overrideâs call checker anyway, resulting in strange effects like this: $ perl -e 'use subs "require"; sub require($$){}; require(1,2)' Not enough arguments for main::require at -e line 1, at EOF Execution of -e aborted due to compilation errors. $ perl -e 'use subs "require"; sub require(){}; require()' Too many arguments for main::require at -e line 1, at EOF Execution of -e aborted due to compilation errors. The subâs own prototype should either apply or not apply; we should not have some hybrid behaviour half way in between. In this case, since require has its own parsing, that should take precedence. M op.c M t/comp/bproto.t commit e3b3621916b3e0a37964e010a49d343f14f098ba Author: Father Chrysostomos <[email protected]> Date: Sun Apr 29 00:06:51 2012 -0700 op.c:ck_glob: Ignore sub prototype The glob operator doesnât allow its syntax to be overridden. But it was still calling an overrideâs call checker anyway, resulting in strange effects like this: $ perl5.15.9 -e 'use subs "glob"; sub glob($$){} glob 1,2' Too many arguments for glob at -e line 1, at EOF Not enough arguments for main::glob at -e line 1, at EOF Execution of -e aborted due to compilation errors. The subâs own prototype should either apply or not apply; we should not have some hybrid behaviour half way in between (two many and not enough at the same timeâ½). In this case, since glob has its own parsing, that should take precedence. M op.c M t/comp/bproto.t commit 22988503093fa0370d330248fc7aa1026b02bfc4 Author: Father Chrysostomos <[email protected]> Date: Sat Apr 28 23:59:46 2012 -0700 op.c:dofile: Ignore sub prototype The do-FILE operator doesnât allow its syntax to be overridden. But it was still calling an overrideâs call checker anyway, resulting in strange effects like this: $ perl -e 'use subs "do"; sub do($$){}; do(1,2)' Not enough arguments for main::do at -e line 1, at EOF Execution of -e aborted due to compilation errors. $ perl -e 'use subs "do"; sub do(){}; do()' Too many arguments for main::do at -e line 1, at EOF Execution of -e aborted due to compilation errors. The subâs own prototype should either apply or not apply; we should not have some hybrid behaviour half way in between. In this case, since âdoâ has its own parsing, that should take precedence. M op.c M t/comp/bproto.t commit 1259c0fdd9d75034999bca098adc9ac2270a285c Author: Father Chrysostomos <[email protected]> Date: Sat Apr 28 23:46:03 2012 -0700 op.c: Remove a redundant ck_subr call from ck_require newUNOP(OP_ENTERSUB, ...) already calls ck_subr, so wrapping it in ck_subr(...) is unnecessary and wasteful of precious CPU time. M op.c commit 9e208eb52439a245da2c336306bcb3427be64c16 Author: Father Chrysostomos <[email protected]> Date: Sat Apr 28 23:45:37 2012 -0700 op.c: Remove a redundant ck_subr call from ck_glob newUNOP(OP_ENTERSUB, ...) already calls ck_subr, so calling ck_subr on its return value is unnecessary and wasteful of precious CPU time. M op.c commit 1b8c33b401d096f5154d776476ce67023f6f07ff Author: Father Chrysostomos <[email protected]> Date: Sat Apr 28 23:43:42 2012 -0700 op.c: Remove a redundant ck_subr call from dofile newUNOP(OP_ENTERSUB, ...) already calls ck_subr, so wrapping it in ck_subr(...) is unnecessary and wasteful of precious CPU time. M op.c commit 26351a7521fe19d96015b0e06ec0a6d9a24468ca Author: Father Chrysostomos <[email protected]> Date: Sat Apr 28 21:27:40 2012 -0700 op.c:ck_glob: Check PL_globhook before loading File::Glob By loading File::Glob when there is no CORE::GLOBAL::glob, we just end up calling Perl_load_module for every glob op, since File::Glob no longer uses CORE::GLOBAL::glob by default. We could just as well check whether PL_globhook is set, which would be faster. (File::Glob sets PL_globhook when it loads. In 5.14, it didnât set anything, but ck_glob itself would set CORE::GLOBAL::glob to File::Glob::csh_glob.) M op.c ----------------------------------------------------------------------- Summary of changes: op.c | 37 ++++++++++++++++++++----------------- t/comp/bproto.t | 15 ++++++++++++++- 2 files changed, 34 insertions(+), 18 deletions(-) diff --git a/op.c b/op.c index ceabbdc..db12337 100644 --- a/op.c +++ b/op.c @@ -4859,10 +4859,11 @@ Perl_dofile(pTHX_ OP *term, I32 force_builtin) } if (gv && GvCVu(gv) && GvIMPORTED_CV(gv)) { - doop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED, + doop = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, term, - scalar(newUNOP(OP_RV2CV, 0, - newGVOP(OP_GV, 0, gv)))))); + scalar(newUNOP(OP_RV2CV, + OPpENTERSUB_AMPER<<8, + newGVOP(OP_GV, 0, gv))))); } else { doop = newUNOP(OP_DOFILE, 0, scalar(term)); @@ -8140,15 +8141,6 @@ Perl_ck_glob(pTHX_ OP *o) gv = gv_fetchpvs("CORE::GLOBAL::glob", 0, SVt_PVCV); } -#if !defined(PERL_EXTERNAL_GLOB) - if (!(gv && GvCVu(gv) && GvIMPORTED_CV(gv))) { - ENTER; - Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, - newSVpvs("File::Glob"), NULL, NULL, NULL); - LEAVE; - } -#endif /* !PERL_EXTERNAL_GLOB */ - if (gv && GvCVu(gv) && GvIMPORTED_CV(gv)) { /* convert * glob @@ -8167,13 +8159,22 @@ Perl_ck_glob(pTHX_ OP *o) o = newLISTOP(OP_LIST, 0, o, NULL); o = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, o, - scalar(newUNOP(OP_RV2CV, 0, + scalar(newUNOP(OP_RV2CV, + OPpENTERSUB_AMPER<<8, newGVOP(OP_GV, 0, gv))))); - o = newUNOP(OP_NULL, 0, ck_subr(o)); + o = newUNOP(OP_NULL, 0, o); o->op_targ = OP_GLOB; /* hint at what it used to be: eg in newWHILEOP */ return o; } else o->op_flags &= ~OPf_SPECIAL; +#if !defined(PERL_EXTERNAL_GLOB) + if (!PL_globhook) { + ENTER; + Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, + newSVpvs("File::Glob"), NULL, NULL, NULL); + LEAVE; + } +#endif /* !PERL_EXTERNAL_GLOB */ gv = newGVgen("main"); gv_IOadd(gv); op_append_elem(OP_GLOB, o, newGVOP(OP_GV, 0, gv)); @@ -8673,11 +8674,13 @@ Perl_ck_require(pTHX_ OP *o) #ifndef PERL_MAD op_free(o); #endif - newop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED, + newop = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, kid, - scalar(newUNOP(OP_RV2CV, 0, + scalar(newUNOP(OP_RV2CV, + OPpENTERSUB_AMPER + << 8, newGVOP(OP_GV, 0, - gv)))))); + gv))))); op_getmad(o,newop,'O'); return newop; } diff --git a/t/comp/bproto.t b/t/comp/bproto.t index bc0f1a2..7d7b1e9 100644 --- a/t/comp/bproto.t +++ b/t/comp/bproto.t @@ -8,7 +8,7 @@ BEGIN { @INC = '../lib'; } -print "1..14\n"; +print "1..17\n"; my $i = 1; @@ -55,3 +55,16 @@ q[ scalar(&foo,$bar); __LINE__(); __PACKAGE__(); ]; + +{ + local *CORE::GLOBAL::require = + local *CORE::GLOBAL::glob = + local *CORE::GLOBAL::do = sub ($$){}; + eval ' + test_no_error($_) for split /\n\s+/, + q[ do(1) + glob(1) + require(1) + ] + '; +} -- Perl5 Master Repository
