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
$^R undefined on matches involving backreferences #8070
Comments
From david@landgren.netCreated by david@landgren.netIt is possible to use simple expressions in (?{...}) constructs, When optional (?:...)? patterns are used, the engine appears This behaviour is seen in 5.005_03, 5.8.5 and 5.8.6. There do not appear to be any tests that check how $^R should (The following tests all pass except for the following: not ok 8 - $^R == 8 $^R is in fact equal to 7). __TEST_FILE_BEGIN__ $^R = undef; $^R = undef; $^R = undef; $^R = undef; $^R = undef; my @ar; $^R = undef; @ar = (); @ar = (); use vars '@var'; ok( 'ab' =~ /^a(?{push @var,19})(?:b(?{push @var,20}))?/, 'ab =~ ab?' ); @var = (); @var = (); Perl Info
|
From david@landgren.netdavid@landgren.net (via RT) wrote:
[...]
Late night bad wording. There are indeed tests for $^R in t/op/pat.t but Playing around some more, the following match, but $^R does not contain $^R = undef; $^R = undef; David |
From DanVDascalescu@yahoo.comCreated by ddascalescu@gmail.comThe LAST_REGEXP_CODE_RESULT ($^R) variable appears to not be set #! perl -w print $^R, "\n" if 'x foofoo y' =~ m{ Hope that helps, Perl Info
|
From @demerphqAttached patch fixes this bug. It also includes a todo test for ticket 6006, and some massaging of the Cheers, |
From @demerphqrt_36909.patchIndex: regexec.c
===================================================================
--- regexec.c (revision 115)
+++ regexec.c (working copy)
@@ -2623,6 +2623,7 @@
during a successfull match */
U32 lastopen = 0; /* last open we saw */
bool has_cutgroup = RX_HAS_CUTGROUP(rex) ? 1 : 0;
+
/* these three flags are set by various ops to signal information to
* the very next op. They have a useful lifetime of exactly one loop
@@ -3867,7 +3868,15 @@
}
case CURLYX_end: /* just finished matching all of A*B */
- regcpblow(ST.cp);
+ if (PL_reg_eval_set){
+ SV *pres= GvSV(PL_replgv);
+ SvREFCNT_inc(pres);
+ regcpblow(ST.cp);
+ sv_setsv(GvSV(PL_replgv), pres);
+ SvREFCNT_dec(pres);
+ } else {
+ regcpblow(ST.cp);
+ }
cur_curlyx = ST.prev_curlyx;
sayYES;
/* NOTREACHED */
Index: t/op/pat.t
===================================================================
--- t/op/pat.t (revision 115)
+++ t/op/pat.t (working copy)
@@ -12,6 +12,7 @@
chdir 't' if -d 't';
@INC = '../lib';
}
+our $Message="Line";
eval 'use Config'; # Defaults assumed if this fails
@@ -2037,7 +2038,8 @@
sub ok ($;$) {
my($ok, $name) = @_;
- printf "%sok %d - %s\n", ($ok ? "" : "not "), $test, $name||'unnamed';
+ printf "%sok %d - %s\n", ($ok ? "" : "not "), $test,
+ $name||"$Message:".((caller)[2]) ;
printf "# Failed test at line %d\n", (caller)[2] unless $ok;
@@ -3673,7 +3675,8 @@
my $ok= $got eq $expect;
- printf "%sok %d - %s\n", ($ok ? "" : "not "), $test, $name||'unnamed';
+ printf "%sok %d - %s\n", ($ok ? "" : "not "), $test,
+ $name||"$Message:".((caller)[2]);
printf "# Failed test at line %d\n".
"# expected: %s\n".
@@ -3973,6 +3976,7 @@
}
{
# Test named commits and the $REGERROR var
+ local $Message="\$REGERROR";
our $REGERROR;
for $word (qw(bar baz bop)) {
$REGERROR="";
@@ -3981,6 +3985,7 @@
}
}
{ #Regression test for perlbug 40684
+ local $Message="RT#40684 tests:";
my $s = "abc\ndef";
my $rex = qr'^abc$'m;
ok($s =~ m/$rex/);
@@ -3994,6 +3999,7 @@
}
{
+ local $Message="Relative Recursion";
my $parens=qr/(\((?:[^()]++|(?-1))*+\))/;
local $_='foo((2*3)+4-3) + bar(2*(3+4)-1*(2-3))';
my ($all,$one,$two)=('','','');
@@ -4015,6 +4021,39 @@
iseq($_,$spaces,"SUSPEND final string");
iseq($count,1,"Optimiser should have prevented more than one match");
}
+{
+ local $Message="RT#36909 test";
+ $^R = 'Nothing';
+ {
+ local $^R="Bad";
+ ok('x foofoo y' =~ m{
+ (foo) # $^R correctly set
+ (?{ "last regexp code result" })
+ }x);
+ iseq($^R,'last regexp code result');
+ }
+ iseq($^R,'Nothing');
+ {
+ local $^R="Bad";
+
+ ok('x foofoo y' =~ m{
+ (?:foo|bar)+ # $^R correctly set
+ (?{"last regexp code result"})
+ }x);
+ iseq($^R,'last regexp code result');
+ }
+ iseq($^R,'Nothing');
+
+ {
+ local $^R="Bad";
+ ok('x foofoo y' =~ m{
+ (foo|bar)\1+ # $^R undefined
+ (?{"last regexp code result"})
+ }x);
+ iseq($^R,'last regexp code result');
+ }
+ iseq($^R,'Nothing');
+}
# Test counter is at bottom of file. Put new tests above here.
#-------------------------------------------------------------------
@@ -4046,6 +4085,7 @@
or print "# Unexpected outcome: should pass or crash perl\n";
{
+ local $Message="substituation with lookahead (possible segv)";
$_="ns1ns1ns1";
s/ns(?=\d)/ns_/g;
iseq($_,"ns_1ns_1ns_1");
@@ -4060,4 +4100,4 @@
# Put new tests above the dotted line about a page above this comment
# Don't forget to update this!
-BEGIN { print "1..1349\n" };
+BEGIN { print "1..1358\n" };
Index: t/op/subst.t
===================================================================
--- t/op/subst.t (revision 115)
+++ t/op/subst.t (working copy)
@@ -7,7 +7,7 @@
}
require './test.pl';
-plan( tests => 133 );
+plan( tests => 134 );
$x = 'foo';
$_ = "x";
@@ -562,4 +562,13 @@
($c = "\x20\x00\x30\x01\x40\x1A\x50\x1F\x60") =~ s/[\x00-\x1f]//g;
is($c, "\x20\x30\x40\x50\x60", "s/[\\x00-\\x1f]//g");
}
-
+TODO:{
+ local $TODO = "RT#6006 needs resolution";
+ $TODO=$TODO;
+ $_ = "xy";
+ no warnings 'uninitialized';
+ /(((((((((x)))))))))(z)/; # clear $10
+ s/(((((((((x)))))))))(y)/${10}/;
+ is($_,"y","RT#6006: \$_ eq '$_'");
+}
+
\ No newline at end of file
Index: win32/Makefile
===================================================================
--- win32/Makefile (revision 115)
+++ win32/Makefile (working copy)
@@ -1363,7 +1363,7 @@
$(XCOPY) $(PERLDLL) ..\t\$(NULL)
$(XCOPY) $(GLOBEXE) ..\t\$(NULL)
cd ..\t
- $(PERLEXE) -I..\lib harness $(OPT) -re \bpat\b \breg \bre\b $(EXTRA)
+ $(PERLEXE) -I..\lib harness $(OPT) -re \bpat\b \breg \bre\b \bsubst $(EXTRA)
cd ..\win32
regen :
|
From @demerphqAttached patch fixes this bug. It also includes a todo test for ticket 6006, and some massaging of the Cheers, |
@demerphq - Status changed from 'new' to 'open' |
From @TuxOn Fri, 17 Nov 2006 20:09:31 +0100, demerphq <demerphq@gmail.com> wrote: Done, with some whitespace issues in #29308 I noted that regexec.c is very inconsistent in leading whitespace, and also If it wasn't for Dave, I would have fixed it :)
-- |
From @demerphqOn Sun Dec 05 03:50:40 2004, david@landgren.net wrote:
This bug has been merged with 36909, and has been resolved by patch The attached patch updates the tests in t/op/rxcode.t to remove todo's Cheers, |
From @demerphqde-todo_rxcode.patchIndex: t/op/rxcode.t
===================================================================
--- t/op/rxcode.t (revision 115)
+++ t/op/rxcode.t (working copy)
@@ -6,8 +6,6 @@
require './test.pl';
}
-plan tests => 34;
-
$^R = undef;
like( 'a', qr/^a(?{1})(?:b(?{2}))?/, 'a =~ ab?' );
cmp_ok( $^R, '==', 1, '..$^R after a =~ ab?' );
@@ -23,21 +21,16 @@
$^R = undef;
like( 'ab', qr/^a(?{7})(?:b(?{8}))?/, 'ab =~ ab?' );
-TODO: {
- local $TODO = '#32840: $^R value lost in (?:...)? constructs';
- cmp_ok( $^R, '==', 8, '..$^R after ab =~ ab?' );
-}
+cmp_ok( $^R, '==', 8, 'RT#32840:..$^R after ab =~ ab?' );
+
$^R = undef;
like( 'ab', qr/^a(?{9})b?(?{10})/, 'ab =~ ab? (2)' );
cmp_ok( $^R, '==', 10, '..$^R after ab =~ ab? (2)' );
$^R = undef;
like( 'ab', qr/^(a(?{11})(?:b(?{12})))?/, 'ab =~ (ab)? (3)' );
-TODO: {
- local $TODO = '#32840: $^R value lost in (?:...)? constructs (2)';
- cmp_ok( $^R, '==', 12, '..$^R after ab =~ ab? (3)' );
-}
+cmp_ok( $^R, '==', 12, 'RT#32840:..$^R after ab =~ ab? (3)' );
$^R = undef;
unlike( 'ac', qr/^a(?{13})b(?{14})/, 'ac !~ ab' );
@@ -80,3 +73,15 @@
unlike( 'abc', qr/^a(?{push @var,113})b(?{push @var,114})$/, 'abc !~ ab$ (push package var)' );
cmp_ok( scalar(@var), '==', 0, '..still nothing pushed (package)' );
+{
+ local $^R = undef;
+ ok( 'ac' =~ /^a(?{30})(?:b(?{31})|c(?{32}))?/, 'ac =~ a(?:b|c)?' );
+ ok( $^R == 32, '$^R == 32' );
+}
+{
+ local $^R = undef;
+ ok( 'abbb' =~ /^a(?{36})(?:b(?{37})|c(?{38}))+/, 'abbbb =~ a(?:b|c)+' );
+ ok( $^R == 37, '$^R == 37' ) or print "# \$^R=$^R\n";
+}
+
+BEGIN { plan tests => 38; }
\ No newline at end of file
Index: win32/Makefile
===================================================================
--- win32/Makefile (revision 145)
+++ win32/Makefile (working copy)
@@ -1363,7 +1363,7 @@
$(XCOPY) $(PERLDLL) ..\t\$(NULL)
$(XCOPY) $(GLOBEXE) ..\t\$(NULL)
cd ..\t
- $(PERLEXE) -I..\lib harness $(OPT) -re \bpat\b \breg \bre\b \bsubst $(EXTRA)
+ $(PERLEXE) -I..\lib harness $(OPT) -re \bpat\b \breg \bre\b \bsubst \brxcode $(EXTRA)
cd ..\win32
regen :
|
@demerphq - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#36909 (status was 'resolved')
Searchable as RT36909$
The text was updated successfully, but these errors were encountered: