[perl #24237] @& should not stop $& from working

Mentioning $& in a program slows everything down, because it force
regular expressions to do a pre-match copy.

It used to happen for any symbol named &, e.g., @& and %&.  This was
changed in commit b4a9608f339, but that commit did not take into
account that the code path in question is only followed on creation of
the *& glob.

It should still be applying magic to $&, even if it is not setting
PL_sawampersand.  The other place in gv_fetchpvn_flags that magical-
ises scalars (which currently handles %- %+ %! $] and @ISA), should
also turn on PL_sawampersand for $&.

All of the above applies to $' and $` as well.
This commit is contained in:
Father Chrysostomos 2012-01-10 13:23:34 -08:00
parent d29a1dbb96
commit a289ef89ae
2 changed files with 18 additions and 5 deletions

13
gv.c
View File

@ -1650,8 +1650,14 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
else if (*name == '-' || *name == '+')
require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), "TIEHASH", 0);
}
if ((sv_type==SVt_PV || sv_type==SVt_PVGV) && *name == '[')
if (sv_type==SVt_PV || sv_type==SVt_PVGV) {
if (*name == '[')
require_tie_mod(gv,name,newSVpvs("arybase"),"FETCH",0);
else if (*name == '&' || *name == '`' || *name == '\'') {
PL_sawampersand = TRUE;
(void)GvSVn(gv);
}
}
}
else if (len == 3 && sv_type == SVt_PVAV
&& strnEQ(name, "ISA", 3)
@ -1859,14 +1865,13 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
case '&': /* $& */
case '`': /* $` */
case '\'': /* $' */
if (
if (!(
sv_type == SVt_PVAV ||
sv_type == SVt_PVHV ||
sv_type == SVt_PVCV ||
sv_type == SVt_PVFM ||
sv_type == SVt_PVIO
) { break; }
PL_sawampersand = TRUE;
)) { PL_sawampersand = TRUE; }
goto magicalize;
case ':': /* $: */

View File

@ -5,7 +5,7 @@ BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
require './test.pl';
plan (tests => 150);
plan (tests => 153);
}
# Test that defined() returns true for magic variables created on the fly,
@ -180,6 +180,14 @@ is $&, 'bar';
is $', 'baz';
is $+, 'a';
# [perl #24237]
for (qw < ` & ' >) {
fresh_perl_is
qq < \@$_; q "fff" =~ /(?!^)./; print "[\$$_]\\n" >,
"[f]\n", {},
"referencing \@$_ before \$$_ etc. still saws off ampersands";
}
# $"
@a = qw(foo bar baz);
is "@a", "foo bar baz";