In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/dc3e91f6d6ea441e8f6ea23d87efab6e7169142a?hp=53eda0bff2fe09151fa42625b5e16ba2307a8b9b>
- Log ----------------------------------------------------------------- commit dc3e91f6d6ea441e8f6ea23d87efab6e7169142a Author: Father Chrysostomos <[email protected]> Date: Tue Nov 5 05:48:44 2013 -0800 gv.c: Removed redundant len==1 check When I added this in ea238638, I put the same code in the branches for the main stash and other stashes. In the main stash branch, this occurs in a switch that is solely for one-character names, so checking the length again is superfluous. M gv.c commit 5882ddb381a033c6699801b9b1046860bf7bfa9c Author: Father Chrysostomos <[email protected]> Date: Mon Nov 4 21:52:55 2013 -0800 toke.c: Remove unnecessary SvRV null check If SvROK is true, then SvRV will never be null. (If it is, then serious problems will occur elsewhere, as other code assumes this.) M toke.c commit 952ad5fef90a698364a2c483108893d79afc5645 Author: Father Chrysostomos <[email protected]> Date: Mon Nov 4 21:49:27 2013 -0800 Fix readpipe overriden with a constant qx and `` donât take into account that some subs are stored in a more lightweight form than usual. These two programs should behave the same way, but, as you can see below the __END__ markers, the output is different: use constant foo=>1; BEGIN { *{"CORE::GLOBAL::readpipe"} = \&{"foo"}; 1} warn `` __END__ Warning: something's wrong at - line 3. use constant foo=>1; BEGIN { *{"CORE::GLOBAL::readpipe"} = \&{"foo"}; 1} warn `` __END__ Too many arguments for CORE::GLOBAL::readpipe at - line 3, at end of line Execution of -e aborted due to compilation errors. The latter is the correct behaviour.¹ The only different is \&{"foo"} vs \&foo, which triggers an optimisation. S_readpipe_override in toke.c needs to take the optimisation into account (that stash entries are not necessarily globs but can be upgraded to such). ¹ Except that the sub name reported is unexpected. Non-threaded builds give me that; threaded builds give me main::foo. But that is a separate bug. M t/op/override.t M toke.c ----------------------------------------------------------------------- Summary of changes: gv.c | 2 +- t/op/override.t | 9 ++++++++- toke.c | 13 +++++++++---- 3 files changed, 18 insertions(+), 6 deletions(-) diff --git a/gv.c b/gv.c index 62652fe..f600942 100644 --- a/gv.c +++ b/gv.c @@ -2023,7 +2023,7 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, break; case 'a': case 'b': - if (len == 1 && sv_type == SVt_PV) + if (sv_type == SVt_PV) GvMULTI_on(gv); } } diff --git a/t/op/override.t b/t/op/override.t index 71c2ac2..15afb05 100644 --- a/t/op/override.t +++ b/t/op/override.t @@ -8,7 +8,7 @@ BEGIN { require 'Config_heavy.pl'; # since runperl will need them } -plan tests => 32; +plan tests => 33; # # This file tries to test builtin override using CORE::GLOBAL @@ -162,3 +162,10 @@ is runperl(prog => 'sub CORE::GLOBAL::glob; glob; print qq-ok\n-'), is runperl(prog => 'sub CORE::GLOBAL::require; require re; print qq-o\n-'), "o\n", 'no crash with CORE::GLOBAL::require stub'; + +like runperl(prog => 'use constant foo=>1; ' + .'BEGIN { *{q|CORE::GLOBAL::readpipe|} = \&{q|foo|};1}' + .'warn ``', + stderr => 1), + qr/Too many arguments/, + '`` does not ignore &CORE::GLOBAL::readpipe aliased to a constant'; diff --git a/toke.c b/toke.c index f9d0a62..08421ff 100644 --- a/toke.c +++ b/toke.c @@ -2866,8 +2866,8 @@ S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e) * validation. */ table = GvHV(PL_hintgv); /* ^H */ cvp = hv_fetchs(table, "charnames", FALSE); - if (cvp && (cv = *cvp) && SvROK(cv) && ((rv = SvRV(cv)) != NULL) - && SvTYPE(rv) == SVt_PVCV && ((stash = CvSTASH(rv)) != NULL)) + if (cvp && (cv = *cvp) && SvROK(cv) && (rv = SvRV(cv), + SvTYPE(rv) == SVt_PVCV) && ((stash = CvSTASH(rv)) != NULL)) { const char * const name = HvNAME(stash); if strEQ(name, "_charnames") { @@ -4487,8 +4487,13 @@ S_readpipe_override(pTHX) && GvCVu(gv_readpipe) && GvIMPORTED_CV(gv_readpipe)) || ((gvp = (GV**)hv_fetchs(PL_globalstash, "readpipe", FALSE)) - && (gv_readpipe = *gvp) && isGV_with_GP(gv_readpipe) - && GvCVu(gv_readpipe) && GvIMPORTED_CV(gv_readpipe))) + && (gv_readpipe = *gvp) && ( + isGV_with_GP(gv_readpipe) + ? GvCVu(gv_readpipe) && GvIMPORTED_CV(gv_readpipe) + : SvPCS_IMPORTED(gv_readpipe) + && (gv_init(gv_readpipe, PL_globalstash, "readpipe", + 8, 0), 1) + ))) { COPLINE_SET_FROM_MULTI_END; PL_lex_op = (OP*)newUNOP(OP_ENTERSUB, OPf_STACKED, -- Perl5 Master Repository
