In perl.git, the branch blead has been updated
<https://perl5.git.perl.org/perl.git/commitdiff/d8422270033e0728e6a9cecb24cdbd123656e367?hp=b9d9f9ab79a4bbe3c10743b2b22828dbb8bd2a46>
- Log -----------------------------------------------------------------
commit d8422270033e0728e6a9cecb24cdbd123656e367
Author: Tony Cook <t...@develop-help.com>
Date: Mon Jun 17 11:46:00 2019 +1000
(perl #134193) make the varname match the %[+-] names
when loading Tie/Hash/NamedCapture.pm for the long name variants
commit 22f05786af0b7f963440e47908cd5f35cf074c12
Author: Tony Cook <t...@develop-help.com>
Date: Thu Jun 13 10:05:15 2019 +1000
(perl #134193) allow %{^CAPTURE} to work when @{^CAPTURE} comes first
gv_magicalize() is called when the GV is created, so when the array
was mentioned first, the hash wouldn't reach this code and the magic
wouldn't be added to the hash.
This also fixes a similar problem with (%|@){^CAPTURE_ALL}, though
@{^CAPTURE_ALL} is unused at this point.
commit 1a1d29aaa2e0c668f9a8c960d52b516415f28983
Author: Vickenty Fesunov <k...@setattr.net>
Date: Fri Sep 22 19:00:46 2017 -0400
%{^CAPTURE_ALL} was intended to be an alias for %-; make it so.
For: RT #131867
Committer: Increment $VERSION in ext/Tie-Hash-NamedCapture/NamedCapture.pm.
Add Vickenty Fesunov to AUTHORS.
-----------------------------------------------------------------------
Summary of changes:
AUTHORS | 1 +
ext/Tie-Hash-NamedCapture/NamedCapture.pm | 2 +-
ext/Tie-Hash-NamedCapture/NamedCapture.xs | 5 ++++-
ext/Tie-Hash-NamedCapture/t/tiehash.t | 14 +++++++++++---
gv.c | 6 ++----
5 files changed, 19 insertions(+), 9 deletions(-)
diff --git a/AUTHORS b/AUTHORS
index 0091100600..c920d52e96 100644
--- a/AUTHORS
+++ b/AUTHORS
@@ -1265,6 +1265,7 @@ Unicode Consortium <unicode.org>
Vadim Konovalov <vkonova...@lucent.com>
Valeriy E. Ushakov <u...@ptc.spbu.ru>
Vernon Lyon <vl...@cpan.org>
+Vickenty Fesunov <k...@setattr.net>
Victor Adam <vic...@drawall.cc>
Victor Efimov <vic...@vsespb.ru>
Viktor Turskyi <koorc...@gmail.com>
diff --git a/ext/Tie-Hash-NamedCapture/NamedCapture.pm
b/ext/Tie-Hash-NamedCapture/NamedCapture.pm
index 32a0029cee..fb505f70a9 100644
--- a/ext/Tie-Hash-NamedCapture/NamedCapture.pm
+++ b/ext/Tie-Hash-NamedCapture/NamedCapture.pm
@@ -1,7 +1,7 @@
use strict;
package Tie::Hash::NamedCapture;
-our $VERSION = "0.10";
+our $VERSION = "0.11";
require XSLoader;
XSLoader::load(); # This returns true, which makes require happy.
diff --git a/ext/Tie-Hash-NamedCapture/NamedCapture.xs
b/ext/Tie-Hash-NamedCapture/NamedCapture.xs
index 7eaae5614d..a607c10090 100644
--- a/ext/Tie-Hash-NamedCapture/NamedCapture.xs
+++ b/ext/Tie-Hash-NamedCapture/NamedCapture.xs
@@ -25,8 +25,11 @@ _tie_it(SV *sv)
GV * const gv = (GV *)sv;
HV * const hv = GvHVn(gv);
SV *rv = newSV_type(SVt_RV);
+ const char *gv_name = GvNAME(gv);
CODE:
- SvRV_set(rv, newSVuv(*GvNAME(gv) == '-' ? RXapif_ALL : RXapif_ONE));
+ SvRV_set(rv, newSVuv(
+ strEQ(gv_name, "-") || strEQ(gv_name, "\003APTURE_ALL")
+ ? RXapif_ALL : RXapif_ONE));
SvROK_on(rv);
sv_bless(rv, GvSTASH(CvGV(cv)));
diff --git a/ext/Tie-Hash-NamedCapture/t/tiehash.t
b/ext/Tie-Hash-NamedCapture/t/tiehash.t
index 3ebc81ad68..cca05278f4 100644
--- a/ext/Tie-Hash-NamedCapture/t/tiehash.t
+++ b/ext/Tie-Hash-NamedCapture/t/tiehash.t
@@ -3,7 +3,15 @@ use strict;
use Test::More;
-my %hashes = ('+' => \%+, '-' => \%-);
+# this would break the hash magic setup [perl #134193]
+my ($ca, $c) = ( \@{^CAPTURE_ALL}, \@{^CAPTURE} );
+
+my %hashes = (
+ '+' => \%+,
+ '-' => \%-,
+ '{^CAPTURE}' => \%{^CAPTURE},
+ '{^CAPTURE_ALL}' => \%{^CAPTURE_ALL},
+);
foreach (['plus1'],
['minus1', all => 1],
@@ -20,12 +28,12 @@ foreach (['plus1'],
is("abcdef" =~ /(?<foo>[ab])*(?<bar>c)(?<foo>d)(?<bar>[ef]*)/, 1,
"We matched");
-foreach my $name (qw(+ plus1 plus2 plus3)) {
+foreach my $name (qw(+ {^CAPTURE} plus1 plus2 plus3)) {
my $hash = $hashes{$name};
is_deeply($hash, { foo => 'b', bar => 'c' }, "%$name is as expected");
}
-foreach my $name (qw(- minus1 minus2)) {
+foreach my $name (qw(- {^CAPTURE_ALL} minus1 minus2)) {
my $hash = $hashes{$name};
is_deeply($hash, { foo => [qw(b d)], bar => [qw(c ef)] },
"%$name is as expected");
diff --git a/gv.c b/gv.c
index 46a32dcc20..652f5e737d 100644
--- a/gv.c
+++ b/gv.c
@@ -2032,13 +2032,11 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char
*name, STRLEN len,
sv_magic(MUTABLE_SV(av), (SV*)n, PERL_MAGIC_regdata, NULL,
0);
SvREADONLY_on(av);
- if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
- require_tie_mod_s(gv, '-',
"Tie::Hash::NamedCapture",0);
+ require_tie_mod_s(gv, '+', "Tie::Hash::NamedCapture",0);
} else /* %{^CAPTURE_ALL} */
if (memEQs(name, len, "\003APTURE_ALL")) {
- if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
- require_tie_mod_s(gv, '+',
"Tie::Hash::NamedCapture",0);
+ require_tie_mod_s(gv, '-', "Tie::Hash::NamedCapture",0);
}
break;
case '\005': /* $^ENCODING */
--
Perl5 Master Repository
