diff options
| author | Father Chrysostomos <sprout@cpan.org> | 2011-07-21 23:18:44 -0700 |
|---|---|---|
| committer | Father Chrysostomos <sprout@cpan.org> | 2011-07-21 23:44:17 -0700 |
| commit | 7ffa7e7540d4523072b049e2d1285c34faabeeb9 (patch) | |
| tree | d071fe530bd6712b5576ac342d3087e4a9fac0ac | |
| parent | abcb810c88ac3af57afe0fd06c1c339f104b10f9 (diff) | |
| download | perl-7ffa7e7540d4523072b049e2d1285c34faabeeb9.tar.gz | |
Don’t call get-magic twice for sym refs
Dereferencing ops (${}, etc.) were calling get-magic on their operand
twice if it was a symbolic reference, except for &{}.
This commit fixes that, adding tests for all the deref ops, including
&{}, for good measure.
| -rw-r--r-- | pod/perldelta.pod | 7 | ||||
| -rw-r--r-- | pp.c | 14 | ||||
| -rw-r--r-- | t/op/tie_fetch_count.t | 12 |
3 files changed, 30 insertions, 3 deletions
diff --git a/pod/perldelta.pod b/pod/perldelta.pod index d03695a973..944a7b874d 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -365,6 +365,13 @@ effects like C<ref \$_> returning "CODE" in some instances. C<lock>'s prototype has been corrected to C<(\[$@%*])> from C<(\$)>, which was just wrong. +=item * + +Most dereferencing operators (C<${}>, etc.) used to call C<FETCH> twice on +a tied operand when doing a symbolic dereference (looking up a variable by +name, which is not permitted under C<use strict 'refs'>). Only C<&{}> did +not have this problem. This has been fixed. + =back =head1 Known Problems @@ -219,7 +219,15 @@ PP(pp_rv2gv) things. */ RETURN; } - sv = MUTABLE_SV(gv_fetchsv(sv, GV_ADD, SVt_PVGV)); + { + STRLEN len; + const char * const nambeg = SvPV_nomg_const(sv, len); + sv = MUTABLE_SV( + gv_fetchpvn_flags( + nambeg, len, GV_ADD | SvUTF8(sv), SVt_PVGV + ) + ); + } } /* FAKE globs in the symbol table cause weird bugs (#77810) */ if (sv) SvFAKE_off(sv); @@ -281,7 +289,9 @@ Perl_softref2xv(pTHX_ SV *const sv, const char *const what, } } else { - gv = gv_fetchsv(sv, GV_ADD, type); + STRLEN len; + const char * const nambeg = SvPV_nomg_const(sv, len); + gv = gv_fetchpvn_flags(nambeg, len, GV_ADD | SvUTF8(sv), type); } return gv; } diff --git a/t/op/tie_fetch_count.t b/t/op/tie_fetch_count.t index 6d2da1cd24..b9fd2751af 100644 --- a/t/op/tie_fetch_count.t +++ b/t/op/tie_fetch_count.t @@ -7,7 +7,7 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; require './test.pl'; - plan (tests => 210); + plan (tests => 215); } use strict; @@ -175,6 +175,16 @@ $dummy = keys $var3 ; check_count 'keys hashref'; tie my $var5 => 'main', sub {1}; $dummy = &$var5 ; check_count '&{}'; +{ + no strict 'refs'; + tie my $var1 => 'main', 1; + $dummy = $$var1 ; check_count 'symbolic ${}'; + $dummy = @$var1 ; check_count 'symbolic @{}'; + $dummy = %$var1 ; check_count 'symbolic %{}'; + $dummy = *$var1 ; check_count 'symbolic *{}'; + local *1 = sub{}; + $dummy = &$var1 ; check_count 'symbolic &{}'; +} ############################################### # Tests for $foo binop $foo # |