Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Accessing @{^CAPTURE} before %{^CAPTURE} empties the latter #17045

Closed
p5pRT opened this issue Jun 12, 2019 · 10 comments
Closed

Accessing @{^CAPTURE} before %{^CAPTURE} empties the latter #17045

p5pRT opened this issue Jun 12, 2019 · 10 comments
Labels

Comments

@p5pRT
Copy link
Collaborator

@p5pRT p5pRT commented Jun 12, 2019

Migrated from rt.perl.org#134193 (status was 'pending release')

Searchable as RT134193$

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 12, 2019

From @haukex

Hi all,

As reported by vr on PerlMonks
(https://www.perlmonks.org/?node_id=11101258), accessing @​{^CAPTURE}
before %{^CAPTURE} causes the latter to become an empty, untied hash.

$ perl -MData​::Dumper -e '"a"=~/(?<X>a)/; print Dumper \%{^CAPTURE},
\@​{^CAPTURE}, tied(%{^CAPTURE})'
$VAR1 = {
  'X' => 'a'
  };
$VAR2 = [
  'a'
  ];
$VAR3 = bless( do{\(my $o = 256)}, 'Tie​::Hash​::NamedCapture' );

$ perl -MData​::Dumper -e '"a"=~/(?<X>a)/; print Dumper \@​{^CAPTURE},
\%{^CAPTURE}, tied(%{^CAPTURE})'
$VAR1 = [
  'a'
  ];
$VAR2 = {};
$VAR3 = undef;

$ perl -v
This is perl 5, version 28, subversion 1 (v5.28.1) built for x86_64-linux
...

The output I would expect from the second example is​:
$VAR1 = [
  'a'
  ];
$VAR2 = {
  'X' => 'a'
  };
$VAR3 = bless( do{\(my $o = 256)}, 'Tie​::Hash​::NamedCapture' );

Thanks, Regards,
-- Hauke D

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 13, 2019

From @tonycoz

On Wed, 12 Jun 2019 13​:11​:15 -0700, haukex@​zero-g.net wrote​:

Hi all,

As reported by vr on PerlMonks
(https://www.perlmonks.org/?node_id=11101258), accessing @​{^CAPTURE}
before %{^CAPTURE} causes the latter to become an empty, untied hash.

$ perl -MData​::Dumper -e '"a"=~/(?<X>a)/; print Dumper \%{^CAPTURE},
\@​{^CAPTURE}, tied(%{^CAPTURE})'
$VAR1 = {
'X' => 'a'
};
$VAR2 = [
'a'
];
$VAR3 = bless( do{\(my $o = 256)}, 'Tie​::Hash​::NamedCapture' );

$ perl -MData​::Dumper -e '"a"=~/(?<X>a)/; print Dumper \@​{^CAPTURE},
\%{^CAPTURE}, tied(%{^CAPTURE})'
$VAR1 = [
'a'
];
$VAR2 = {};
$VAR3 = undef;

$ perl -v
This is perl 5, version 28, subversion 1 (v5.28.1) built for x86_64-linux
...

The output I would expect from the second example is​:
$VAR1 = [
'a'
];
$VAR2 = {
'X' => 'a'
};
$VAR3 = bless( do{\(my $o = 256)}, 'Tie​::Hash​::NamedCapture' );

The magic setup code assumes it will be called separately for the array and hash (which is incorrect.)

The attached fixes it (applies on top of the 131867 fix).

I'll apply both in a few days unless someone sees a problem.

Tony

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 13, 2019

From @tonycoz

0002-perl-134193-allow-CAPTURE-to-work-when-CAPTURE-comes.patch
From 8d35064a6297dfa52c131ec0165cc3af4ab8f3c7 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Thu, 13 Jun 2019 10:05:15 +1000
Subject: (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.
---
 ext/Tie-Hash-NamedCapture/t/tiehash.t | 3 +++
 gv.c                                  | 6 ++----
 2 files changed, 5 insertions(+), 4 deletions(-)

diff --git a/ext/Tie-Hash-NamedCapture/t/tiehash.t b/ext/Tie-Hash-NamedCapture/t/tiehash.t
index 962754085f..cca05278f4 100644
--- a/ext/Tie-Hash-NamedCapture/t/tiehash.t
+++ b/ext/Tie-Hash-NamedCapture/t/tiehash.t
@@ -3,6 +3,9 @@ use strict;
 
 use Test::More;
 
+# this would break the hash magic setup [perl #134193]
+my ($ca, $c) = ( \@{^CAPTURE_ALL}, \@{^CAPTURE} );
+
 my %hashes = (
     '+' => \%+,
     '-' => \%-,
diff --git a/gv.c b/gv.c
index 46a32dcc20..2b83680898 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 */
-- 
2.11.0

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 13, 2019

The RT System itself - Status changed from 'new' to 'open'

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 13, 2019

From @hvds

On Wed, 12 Jun 2019 17​:22​:33 -0700, tonyc wrote​:

The attached fixes it (applies on top of the 131867 fix).

Can you explain why the similar code for *+ and *- is not similarly wrong? That might be worth a comment in the code too​: it looks like this bug started as essentially a copy of that code.

It would also be worth swapping the '+' and '-' arguments in the two
require_tie_mod_s() calls, as Hauke also noted - if anyone ever sees it, it'll be a confusing-enough error message without being confusing for the wrong reason.

Hugo

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 17, 2019

From @tonycoz

On Thu, 13 Jun 2019 03​:46​:27 -0700, hv wrote​:

On Wed, 12 Jun 2019 17​:22​:33 -0700, tonyc wrote​:

The attached fixes it (applies on top of the 131867 fix).

Can you explain why the similar code for *+ and *- is not similarly
wrong? That might be worth a comment in the code too​: it looks like
this bug started as essentially a copy of that code.

There's special handling in gv_fetchpvn_flags()​:

  if (len == 1 && stash == PL_defstash) {
  maybe_multimagic_gv(gv, name, sv_type);
  }

that calls maybe_multimagic_gv() even if the glob already exists for single character names.

Loading Tie​::Hash​::NamedCapture when only @​{^CAPTURE} is being referenced is a minor performance hit, maybe that's what the handling for @​+ is trying to avoid.

It would also be worth swapping the '+' and '-' arguments in the two
require_tie_mod_s() calls, as Hauke also noted - if anyone ever sees
it, it'll be a confusing-enough error message without being confusing
for the wrong reason.

Attached, applies after the other two.

Tony

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 17, 2019

From @tonycoz

0003-perl-134193-make-the-varname-match-the-names.patch
From 57295e661f521dc6c9f89b283ff5b34f375e504c Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 17 Jun 2019 11:46:00 +1000
Subject: (perl #134193) make the varname match the %[+-] names

when loading Tie/Hash/NamedCapture.pm for the long name variants
---
 gv.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/gv.c b/gv.c
index 2b83680898..652f5e737d 100644
--- a/gv.c
+++ b/gv.c
@@ -2032,11 +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);
 
-                    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")) {
-                    require_tie_mod_s(gv, '+', "Tie::Hash::NamedCapture",0);
+                    require_tie_mod_s(gv, '-', "Tie::Hash::NamedCapture",0);
                 }
 		break;
 	    case '\005':	/* $^ENCODING */
-- 
2.11.0

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 19, 2019

From @tonycoz

On Wed, 12 Jun 2019 17​:22​:33 -0700, tonyc wrote​:

On Wed, 12 Jun 2019 13​:11​:15 -0700, haukex@​zero-g.net wrote​:

Hi all,

As reported by vr on PerlMonks
(https://www.perlmonks.org/?node_id=11101258), accessing @​{^CAPTURE}
before %{^CAPTURE} causes the latter to become an empty, untied hash.

$ perl -MData​::Dumper -e '"a"=~/(?<X>a)/; print Dumper \%{^CAPTURE},
\@​{^CAPTURE}, tied(%{^CAPTURE})'
$VAR1 = {
'X' => 'a'
};
$VAR2 = [
'a'
];
$VAR3 = bless( do{\(my $o = 256)}, 'Tie​::Hash​::NamedCapture' );

$ perl -MData​::Dumper -e '"a"=~/(?<X>a)/; print Dumper \@​{^CAPTURE},
\%{^CAPTURE}, tied(%{^CAPTURE})'
$VAR1 = [
'a'
];
$VAR2 = {};
$VAR3 = undef;

$ perl -v
This is perl 5, version 28, subversion 1 (v5.28.1) built for x86_64-
linux
...

The output I would expect from the second example is​:
$VAR1 = [
'a'
];
$VAR2 = {
'X' => 'a'
};
$VAR3 = bless( do{\(my $o = 256)}, 'Tie​::Hash​::NamedCapture' );

The magic setup code assumes it will be called separately for the
array and hash (which is incorrect.)

The attached fixes it (applies on top of the 131867 fix).

I'll apply both in a few days unless someone sees a problem.

Done in 1a1d29a and 22f0578, and applied the changes to the varname parameter in d842227.

Tony

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 19, 2019

@tonycoz - Status changed from 'open' to 'pending release'

@p5pRT p5pRT closed this Jun 19, 2019
@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 19, 2019

From @demerphq

Thank you Tony, you are correct about the origin of the code.

Yves

On Wed, 19 Jun 2019, 07​:16 Tony Cook via RT, <perlbug-followup@​perl.org>
wrote​:

On Wed, 12 Jun 2019 17​:22​:33 -0700, tonyc wrote​:

On Wed, 12 Jun 2019 13​:11​:15 -0700, haukex@​zero-g.net wrote​:

Hi all,

As reported by vr on PerlMonks
(https://www.perlmonks.org/?node_id=11101258), accessing @​{^CAPTURE}
before %{^CAPTURE} causes the latter to become an empty, untied hash.

$ perl -MData​::Dumper -e '"a"=~/(?<X>a)/; print Dumper \%{^CAPTURE},
\@​{^CAPTURE}, tied(%{^CAPTURE})'
$VAR1 = {
'X' => 'a'
};
$VAR2 = [
'a'
];
$VAR3 = bless( do{\(my $o = 256)}, 'Tie​::Hash​::NamedCapture' );

$ perl -MData​::Dumper -e '"a"=~/(?<X>a)/; print Dumper \@​{^CAPTURE},
\%{^CAPTURE}, tied(%{^CAPTURE})'
$VAR1 = [
'a'
];
$VAR2 = {};
$VAR3 = undef;

$ perl -v
This is perl 5, version 28, subversion 1 (v5.28.1) built for x86_64-
linux
...

The output I would expect from the second example is​:
$VAR1 = [
'a'
];
$VAR2 = {
'X' => 'a'
};
$VAR3 = bless( do{\(my $o = 256)}, 'Tie​::Hash​::NamedCapture' );

The magic setup code assumes it will be called separately for the
array and hash (which is incorrect.)

The attached fixes it (applies on top of the 131867 fix).

I'll apply both in a few days unless someone sees a problem.

Done in 1a1d29a and
22f0578, and applied the changes to the
varname parameter in d842227.

Tony

---
via perlbug​: queue​: perl5 status​: open
https://rt-archive.perl.org/perl5/Ticket/Display.html?id=134193

@p5pRT p5pRT added the Severity Low label Oct 19, 2019
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Linked pull requests

Successfully merging a pull request may close this issue.

None yet
1 participant
You can’t perform that action at this time.