In perl.git, the branch sprout/cvgv has been updated <http://perl5.git.perl.org/perl.git/commitdiff/e4fec18af8d2b3e4276665b7ac8625039bc0dae3?hp=2c8c8eb6dc0ddd2049932c0228684a2f26c3640d>
- Log ----------------------------------------------------------------- commit e4fec18af8d2b3e4276665b7ac8625039bc0dae3 Author: Father Chrysostomos <[email protected]> Date: Thu Sep 4 22:07:53 2014 -0700 Optimize CVs by eliminating GVs where possible The various weirdly-named commits leading up to this one are part of it and will be squashed. This does not fully work yet. minitest passes, but make still fails. M pp.c commit 356b176c6d81d86e1bf6e64c375d27c34691a45c Author: Father Chrysostomos <[email protected]> Date: Thu Sep 4 20:22:51 2014 -0700 etc M op.c M t/op/gv.t M t/uni/gv.t M toke.c ----------------------------------------------------------------------- Summary of changes: op.c | 3 +-- pp.c | 4 +++- t/op/gv.t | 5 ++++- t/uni/gv.t | 2 +- toke.c | 6 +++++- 5 files changed, 14 insertions(+), 6 deletions(-) diff --git a/op.c b/op.c index a90ba6f..f770352 100644 --- a/op.c +++ b/op.c @@ -8020,7 +8020,7 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, if (block && has_name) { if (PERLDB_SUBLINE && PL_curstash != PL_debstash) { - SV * const tmpstr = sv_newmortal(); + SV * const tmpstr = cv_name(cv,NULL); GV * const db_postponed = gv_fetchpvs("DB::postponed", GV_ADDMULTI, SVt_PVHV); HV *hv; @@ -8028,7 +8028,6 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, CopFILE(PL_curcop), (long)PL_subline, (long)CopLINE(PL_curcop)); - gv_efullname3(tmpstr, gv, NULL); (void)hv_store(GvHV(PL_DBsub), SvPVX_const(tmpstr), SvUTF8(tmpstr) ? -(I32)SvCUR(tmpstr) : (I32)SvCUR(tmpstr), sv, 0); hv = GvHVn(db_postponed); diff --git a/pp.c b/pp.c index 7cadace..ea05bb4 100644 --- a/pp.c +++ b/pp.c @@ -472,7 +472,9 @@ PP(pp_rv2cv) CV *cv = sv_2cv(TOPs, &stash_unused, &gv, flags); if (cv) NOOP; else if ((flags == (GV_ADD|GV_NOEXPAND)) && gv && SvROK(gv)) { - cv = MUTABLE_CV(gv); + cv = SvTYPE(SvRV(gv)) == SVt_PVCV + ? MUTABLE_CV(SvRV(gv)) + : MUTABLE_CV(gv); } else cv = MUTABLE_CV(&PL_sv_undef); diff --git a/t/op/gv.t b/t/op/gv.t index 279a9af..4c8c79d 100644 --- a/t/op/gv.t +++ b/t/op/gv.t @@ -490,6 +490,9 @@ is join("-", eval "&yarrow(1..10)"), '4-5-6', 'const list ignores & args'; is prototype "yarrow", "", 'const list has "" prototype'; is eval "yarrow", 3, 'const list in scalar cx returns length'; +$::{borage} = \&ok; +eval 'borage("sub ref in stash")' or fail "sub ref in stash"; + { use vars qw($glook $smek $foof); # Check reference assignment isn't affected by the SV type (bug #38439) @@ -512,7 +515,7 @@ is eval "yarrow", 3, 'const list in scalar cx returns length'; format = . -foreach my $value ({1=>2}, *STDOUT{IO}, \&ok, *STDOUT{FORMAT}) { +foreach my $value ({1=>2}, *STDOUT{IO}, *STDOUT{FORMAT}) { # *STDOUT{IO} returns a reference to a PVIO. As it's blessed, ref returns # IO::Handle, which isn't what we want. my $type = $value; diff --git a/t/uni/gv.t b/t/uni/gv.t index 9143034..135b573 100644 --- a/t/uni/gv.t +++ b/t/uni/gv.t @@ -492,7 +492,7 @@ no warnings 'once'; format = . - foreach my $value ({1=>2}, *STDOUT{IO}, \&ok, *STDOUT{FORMAT}) { + foreach my $value ({1=>2}, *STDOUT{IO}, *STDOUT{FORMAT}) { # *STDOUT{IO} returns a reference to a PVIO. As it's blessed, ref returns # IO::Handle, which isn't what we want. my $type = $value; diff --git a/toke.c b/toke.c index e5e3ddf..ba06a64 100644 --- a/toke.c +++ b/toke.c @@ -6563,7 +6563,11 @@ Perl_yylex(pTHX) rv2cv_op = newCVREF(OPpMAY_RETURN_CONSTANT<<8, const_op); cv = lex - ? isGV(gv) ? GvCV(gv) : (CV *)gv + ? isGV(gv) + ? GvCV(gv) + : SvROK(gv) && SvTYPE(SvRV(gv)) == SVt_PVCV + ? (CV *)SvRV(gv) + : (CV *)gv : rv2cv_op_cv(rv2cv_op, RV2CVOPCV_RETURN_STUB); } -- Perl5 Master Repository
