From 28d8d7f41ab202dd5f7611033d27ecad44cadd60 Mon Sep 17 00:00:00 2001 From: Yves Orton Date: Wed, 21 Mar 2007 11:39:24 +0100 Subject: Resolve PL_curpm issues with (??{}) and fix corruption of match results when pattern is a qr. Message-ID: <9b18b3110703210239x540f5ad9mdb41c2ea6229ac31@mail.gmail.com> plus two follow-up patches (minor tweaks) p4raw-id: //depot/perl@30678 --- ext/Devel/Peek/t/Peek.t | 2 ++ ext/Encode/t/Aliases.t | 1 + ext/re/re.pm | 46 ++++++++++++++++++++-------------------------- ext/re/t/re_funcs.t | 30 ++++++------------------------ 4 files changed, 29 insertions(+), 50 deletions(-) (limited to 'ext') diff --git a/ext/Devel/Peek/t/Peek.t b/ext/Devel/Peek/t/Peek.t index d3a957a068..43dcb1cbfd 100644 --- a/ext/Devel/Peek/t/Peek.t +++ b/ext/Devel/Peek/t/Peek.t @@ -282,6 +282,8 @@ do_test(15, MG_VIRTUAL = $ADDR MG_TYPE = PERL_MAGIC_qr\(r\) MG_OBJ = $ADDR + PAT = "\(\?-xism:tic\)" + REFCNT = 2 STASH = $ADDR\\t"Regexp"'); do_test(16, diff --git a/ext/Encode/t/Aliases.t b/ext/Encode/t/Aliases.t index ff86ed1d0a..9c7094460a 100644 --- a/ext/Encode/t/Aliases.t +++ b/ext/Encode/t/Aliases.t @@ -122,6 +122,7 @@ use Test::More tests => (scalar keys %a2c) * 4; print "# alias test; \$ON_EBCDIC == $ON_EBCDIC\n"; foreach my $a (keys %a2c){ + print "# $a => $a2c{$a}\n"; my $e = Encode::find_encoding($a); is((defined($e) and $e->name), $a2c{$a},$a) or warn "alias was $a";; diff --git a/ext/re/re.pm b/ext/re/re.pm index c33ca3c522..e06602da33 100644 --- a/ext/re/re.pm +++ b/ext/re/re.pm @@ -473,45 +473,39 @@ floating string. This will be what the optimiser of the Perl that you are using thinks is the longest. If you believe that the result is wrong please report it via the L utility. -=item regname($name,$qr,$all) +=item regname($name,$all) -Returns the contents of a named buffer. If $qr is missing, or is not the -result of a qr// then returns the result of the last successful match. If -$all is true then returns an array ref containing one entry per buffer, +Returns the contents of a named buffer of the last successful match. If +$all is true, then returns an array ref containing one entry per buffer, otherwise returns the first defined buffer. -=item regnames($qr,$all) +=item regnames($all) -Returns a list of all of the named buffers defined in a pattern. If -$all is true then it returns all names defined, if not returns only -names which were involved in the last successful match. If $qr is omitted -or is not the result of a qr// then returns the details for the last -successful match. +Returns a list of all of the named buffers defined in the last successful +match. If $all is true, then it returns all names defined, if not it returns +only names which were involved in the match. -=item regnames_iterinit($qr) +=item regnames_iterinit() -Initializes the internal hash iterator associated to a regexps named capture -buffers. If $qr is omitted resets the iterator associated with the regexp used -in the last successful match. +Initializes the internal hash iterator associated to the last successful +matches named capture buffers. -=item regnames_iternext($qr,$all) +=item regnames_iternext($all) -Gets the next key from the hash associated with a regexp. If $qr -is omitted resets the iterator associated with the regexp used in the -last successful match. If $all is true returns the keys of all of the +Gets the next key from the named capture buffer hash associated with the +last successful match. If $all is true returns the keys of all of the distinct named buffers in the pattern, if not returns only those names used in the last successful match. -=item regnames_count($qr) +=item regnames_count() -Returns the number of distinct names defined in the regexp $qr. If -$qr is omitted or not a regexp returns the count of names in the -last successful match. +Returns the number of distinct names defined in the pattern used +for the last successful match. -B that this result is always the actual number of distinct -named buffers defined, it may not actually match that which is -returned by C and related routines when those routines -have not been called with the $all parameter set.. +B this result is always the actual number of distinct +named buffers defined, it may not actually match that which is +returned by C and related routines when those routines +have not been called with the $all parameter set. =back diff --git a/ext/re/t/re_funcs.t b/ext/re/t/re_funcs.t index 6bdafcb745..0d9092aa64 100644 --- a/ext/re/t/re_funcs.t +++ b/ext/re/t/re_funcs.t @@ -42,19 +42,14 @@ use re qw(is_regexp regexp_pattern regmust if ('1234'=~/(?:(?\d)|(?!))(?\d)(?\d)(?\d)/){ - my $qr = qr/(?foo)(?bar)/; - my @names = sort +regnames($qr); - is("@names","","regnames"); - @names = sort +regnames($qr,1); - is("@names","bar foo","regnames - all"); - @names = sort +regnames(); + my @names = sort +regnames(); is("@names","A B","regnames"); - @names = sort +regnames(undef,1); + @names = sort +regnames(1); is("@names","A B C","regnames"); - is(join("", @{regname("A",undef,1)}),"13"); - is(join("", @{regname("B",undef,1)}),"24"); + is(join("", @{regname("A",1)}),"13"); + is(join("", @{regname("B",1)}),"24"); { - if ('foobar'=~/$qr/) { + if ('foobar'=~/(?foo)(?bar)/) { regnames_iterinit(); my @res; while (defined(my $key=regnames_iternext)) { @@ -68,20 +63,7 @@ if ('1234'=~/(?:(?\d)|(?!))(?\d)(?\d)(?\d)/){ } } is(regnames_count(),3); - is(regnames_count($qr),2); -} -{ - use warnings; - require Tie::Hash::NamedCapture; - my $qr = qr/(?foo)/; - if ( 'foo' =~ /$qr/ ) { - tie my %hash,"Tie::Hash::NamedCapture",re => $qr; - if ('bar'=~/bar/) { - # last successful match is now different - is($hash{foo},'foo'); # prints foo - } - } } # New tests above this line, don't forget to update the test count below! -use Test::More tests => 23; +use Test::More tests => 19; # No tests here! -- cgit v1.2.1