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

$^R undefined on matches involving backreferences #8070

Closed
p5pRT opened this issue Aug 16, 2005 · 11 comments
Closed

$^R undefined on matches involving backreferences #8070

p5pRT opened this issue Aug 16, 2005 · 11 comments

Comments

@p5pRT
Copy link

p5pRT commented Aug 16, 2005

Migrated from rt.perl.org#36909 (status was 'resolved')

Searchable as RT36909$

@p5pRT
Copy link
Author

p5pRT commented Dec 4, 2004

From david@landgren.net

Created by david@landgren.net

It is possible to use simple expressions in (?{...}) constructs,
such as (?{123}), the idea being that they could be picked up
afterwards by reading the contents of $^R.

When optional (?​:...)? patterns are used, the engine appears
to become confused and $^R is set to the value of the expression
prior to the optional part. It can be shown that the code blocks
are in fact executed. Code with side effects (pushing values onto
an array) is run, and the expected results are observed after the
match. The problem occurs only for simple expressions.

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
behave. The following file is an attempt to improve matters.

(The following tests all pass except for the following​:

  not ok 8 - $^R == 8
  # Failed test (./vr at line 21)

$^R is in fact equal to 7).

__TEST_FILE_BEGIN__
use Test​::Simple tests => 26;

$^R = undef;
ok( 'a' =~ /^a(?{1})(?​:b(?{2}))?/, 'a =~ ab?' );
ok( $^R == 1, '$^R == 1' );

$^R = undef;
ok( 'abc' !~ /^a(?{3})(?​:b(?{4}))$/, 'abc !~ a(?​:b)$' );
ok( !defined $^R, 'undef 2nd' );

$^R = undef;
ok( 'ab' =~ /^a(?{5})b(?{6})/, 'ab =~ ab' );
ok( $^R == 6, '$^R == 6' );

$^R = undef;
ok( 'ab' =~ /^a(?{7})(?​:b(?{8}))?/, 'ab =~ ab?' );
ok( $^R == 8, '$^R == 8' );

$^R = undef;
ok( 'ab' =~ /^a(?{9})b?(?{10})/, 'ab =~ ab? (2)' );
ok( $^R == 10, '$^R == 10' );

my @​ar;
ok( 'ab' =~ /^a(?{push @​ar,11})(?​:b(?{push @​ar,12}))?/, 'ab =~ ab?' );
ok( scalar(@​ar) == 2, 'nr pushed ok' );
ok( ($ar[0] == 11 and $ar[1] == 12), 'push contents ok' );

$^R = undef;
ok( 'a' !~ /^a(?{13})b(?{14})/, 'a !~ ab' );
ok( !defined $^R, 'undef 3rd' );

@​ar = ();
ok( 'a' !~ /^a(?{push @​ar,15})b(?{push @​ar,16})/, 'a !~ ab (push)' );
ok( scalar(@​ar) == 0, 'none pushed ok' );

@​ar = ();
ok( 'abc' !~ /^a(?{push @​ar,17})b(?{push @​ar,18})$/, 'abc !~ ab$ (push)' );
ok( scalar(@​ar) == 0, 'none pushed ok' );

use vars '@​var';

ok( 'ab' =~ /^a(?{push @​var,19})(?​:b(?{push @​var,20}))?/, 'ab =~ ab?' );
ok( scalar(@​var) == 2, 'nr pushed ok' );
ok( ($var[0] == 19 and $var[1] == 20), 'push contents ok' );

@​var = ();
ok( 'a' !~ /^a(?{push @​var,21})b(?{push @​var,22})/, 'a !~ ab (push)' );
ok( scalar(@​var) == 0, 'none pushed ok' );

@​var = ();
ok( 'abc' !~ /^a(?{push @​var,23})b(?{push @​var,24})$/, 'abc !~ ab$ (push)' );
ok( scalar(@​var) == 0, 'none pushed ok' );
__TEST_FILE_END__

Perl Info

Flags:
    category=core
    severity=medium

Site configuration information for perl v5.8.6:

Configured by david at Sat Dec  4 17:37:22 CET 2004.

Summary of my perl5 (revision 5 version 8 subversion 6) configuration:
  Platform:
    osname=freebsd, osvers=4.10-stable, archname=i386-freebsd
    uname='freebsd relay.bpinet.com 4.10-stable freebsd 4.10-stable #3: wed jul 28 13:07:34 cest 2004 root@relay.bpinet.com:usrobjusrsrcsysrelay i386 '
    config_args=''
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
    useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
    use64bitint=undef use64bitall=undef uselongdouble=undef
    usemymalloc=y, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-DHAS_FPSETMASK -DHAS_FLOATINGPOINT_H -fno-strict-aliasing -pipe -I/usr/local/include',
    optimize='-O',
    cppflags='-DHAS_FPSETMASK -DHAS_FLOATINGPOINT_H -fno-strict-aliasing -pipe -I/usr/local/include'
    ccversion='', gccversion='2.95.4 20020320 [FreeBSD]', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=4, prototype=define
  Linker and Libraries:
    ld='cc', ldflags ='-Wl,-E  -L/usr/local/lib'
    libpth=/usr/lib /usr/local/lib
    libs=-lm -lcrypt -lutil -lc
    perllibs=-lm -lcrypt -lutil -lc
    libc=, so=so, useshrplib=false, libperl=libperl.a
    gnulibc_version=''
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags=' '
    cccdlflags='-DPIC -fPIC', lddlflags='-shared  -L/usr/local/lib'

Locally applied patches:
    


@INC for perl v5.8.6:
    /usr/local/lib/perl5/5.8.6/i386-freebsd
    /usr/local/lib/perl5/5.8.6
    /usr/local/lib/perl5/site_perl/5.8.6/i386-freebsd
    /usr/local/lib/perl5/site_perl/5.8.6
    /usr/local/lib/perl5/site_perl/5.8.5/i386-freebsd
    /usr/local/lib/perl5/site_perl/5.8.5
    /usr/local/lib/perl5/site_perl/5.005
    /usr/local/lib/perl5/site_perl
    .


Environment for perl v5.8.6:
    HOME=/home/david
    LANG (unset)
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/usr/bin:/bin:/usr/local/bin:.
    PERL_BADLANG (unset)
    SHELL=/usr/local/bin/bash

@p5pRT
Copy link
Author

p5pRT commented Dec 5, 2004

From david@landgren.net

david@​landgren.net (via RT) wrote​:

# New Ticket Created by david@​landgren.net
# Please include the string​: [perl #32840]
# in the subject line of all future correspondence about this issue.
# <URL​: http​://rt.perl.org​:80/rt3/Ticket/Display.html?id=32840 >

[...]

There do not appear to be any tests that check how $^R should
behave. The following file is an attempt to improve matters.

Late night bad wording. There are indeed tests for $^R in t/op/pat.t but
they don't exercise patterns with groupings.

Playing around some more, the following match, but $^R does not contain
what is expected​:

$^R = undef;
ok( 'ac' =~ /^a(?{30})(?​:b(?{31})|c(?{32}))?/, 'ac =~ a(?​:b|c)?' );
ok( $^R == 32, '$^R == 32' );

$^R = undef;
ok( 'abbb' =~ /^a(?{36})(?​:b(?{37})|c(?{38}))+/, 'abbbb =~ a(?​:b|c)+' );
ok( $^R == 37, '$^R == 37' ) or print "# \$^R=$^R\n";

David

@p5pRT
Copy link
Author

p5pRT commented Aug 16, 2005

From DanVDascalescu@yahoo.com

Created by ddascalescu@gmail.com

The LAST_REGEXP_CODE_RESULT ($^R) variable appears to not be set
in regexp matches involving a backreference. In the example below,
if you uncomment one of the two commented regexps and comment the
'(foo|bar)\1+' regexp, $^R will be properly set.

#! perl -w
# $^R undefined on matches involving backreferences
use strict;

print $^R, "\n" if 'x foofoo y' =~ m{
# (foo) # $^R correctly set
# (?​:foo|bar)+ # $^R correctly set
  (foo|bar)\1+ # $^R undefined
  (?{ warn "Matched", defined $^N? " &lt;$^N>"​:"",
  " and \$^R is about to be set to​:\n"; "last regexp code result"
  })
}x

Hope that helps,
Dan Dascalescu

Perl Info

Flags:
    category=core
    severity=low

Site configuration information for perl v5.8.7:

Configured by builder at Mon Jun  6 13:36:05 2005.

Summary of my perl5 (revision 5 version 8 subversion 7) configuration:
  Platform:
    osname=MSWin32, osvers=5.0, archname=MSWin32-x86-multi-thread
    uname=''
    config_args='undef'
    hint=recommended, useposix=true, d_sigaction=undef
    usethreads=define use5005threads=undef useithreads=define usemultiplicity=define
    useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
    use64bitint=undef use64bitall=undef uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cl', ccflags ='-nologo -Gf -W3 -MD -Zi -DNDEBUG -O1 -DWIN32 -D_CONSOLE -DNO_STRICT
-DHAVE_DES_FCRYPT -DBUILT_BY_ACTIVESTATE -DNO_HASH_SEED -DUSE_SITECUSTOMIZE
-DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS -DUSE_PERLIO -DPERL_MSVCRT_READFIX',
    optimize='-MD -Zi -DNDEBUG -O1',
    cppflags='-DWIN32'
    ccversion='12.00.8804', gccversion='', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
    d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=10
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='__int64', lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='link', ldflags ='-nologo -nodefaultlib -debug -opt:ref,icf  -libpath:"D:\Perl\lib\CORE" 
-machine:x86'
    libpth=\lib
    libs=  oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib  comdlg32.lib advapi32.lib
shell32.lib ole32.lib oleaut32.lib  netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib 
version.lib odbc32.lib odbccp32.lib msvcrt.lib
    perllibs=  oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib  comdlg32.lib
advapi32.lib shell32.lib ole32.lib oleaut32.lib  netapi32.lib uuid.lib ws2_32.lib mpr.lib
winmm.lib  version.lib odbc32.lib odbccp32.lib msvcrt.lib
    libc=msvcrt.lib, so=dll, useshrplib=yes, libperl=perl58.lib
    gnulibc_version='undef'
  Dynamic Linking:
    dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
    cccdlflags=' ', lddlflags='-dll -nologo -nodefaultlib -debug -opt:ref,icf 
-libpath:"D:\Perl\lib\CORE"  -machine:x86'

Locally applied patches:
    ACTIVEPERL_LOCAL_PATCHES_ENTRY
    #  if !defined(PERL_DARWIN)
    Iin_load_module moved for compatibility with build 806
    #  endif
    #  if defined(__hpux)
    Avoid signal flag SA_RESTART for older versions of HP-UX
    #  endif
    PerlEx hacks for CGI::Carp
    Less verbose ExtUtils::Install and Pod::Find
    instmodsh upgraded from ExtUtils-MakeMaker-6.25
    24699 ICMP_UNREACHABLE handling in Net::Ping
    21540 Fix backward-compatibility issues in if.pm


@INC for perl v5.8.7:
    D:/Perl/lib
    D:/Perl/site/lib
    .


Environment for perl v5.8.7:
    HOME (unset)
    LANG (unset)
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=D:\Perl\bin\;c:\jdk1.3.1\bin;C:\WINNT\system32;C:\WINNT;C:\WINNT\System32\Wbem;C:\Program
Files\Microsoft Visual Studio\VC98\Bin;C:\Program Files\Microsoft Visual Studio\Common\MSDev98\Bin
    PERL5LIB=D:\Perl\lib\
    PERLDB_OPTS=RemotePort=127.0.0.1:2000
    PERL_BADLANG (unset)
    SHELL (unset)



__________________________________________________
Do You Yahoo!?
Tired of spam?  Yahoo! Mail has the best spam protection around 
http://mail.yahoo.com 

@p5pRT
Copy link
Author

p5pRT commented Nov 17, 2006

From @demerphq

Attached patch fixes this bug.

It also includes a todo test for ticket 6006, and some massaging of the
test-reonly target and better test name defaulting.

Cheers,
Yves

@p5pRT
Copy link
Author

p5pRT commented Nov 17, 2006

From @demerphq

rt_36909.patch
Index: 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 : 

@p5pRT
Copy link
Author

p5pRT commented Nov 17, 2006

From @demerphq

Attached patch fixes this bug.

It also includes a todo test for ticket 6006, and some massaging of the
test-reonly target and better test name defaulting.

Cheers,
Yves

@p5pRT
Copy link
Author

p5pRT commented Nov 17, 2006

@demerphq - Status changed from 'new' to 'open'

@p5pRT
Copy link
Author

p5pRT commented Nov 17, 2006

From @Tux

On 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
has many lines with trailing whitespace.

If it wasn't for Dave, I would have fixed it :)

---------- Forwarded message ----------
From​: yves orton via RT <bugs-perl5@​bugs6.perl.org>
Date​: Nov 17, 2006 4​:07 PM
Subject​: [perl #36909] $^R undefined on matches involving backreferences
To​: "of perl Ticket #36909\"" <"OtherRecipients>
Cc​: perl5-porters@​perl.org

Attached patch fixes this bug.

It also includes a todo test for ticket 6006, and some massaging of the
test-reonly target and better test name defaulting.

--
H.Merijn Brand Amsterdam Perl Mongers (http​://amsterdam.pm.org/)
using & porting perl 5.6.2, 5.8.x, 5.9.x on HP-UX 10.20, 11.00, 11.11,
& 11.23, SuSE 10.0 & 10.1, AIX 4.3 & 5.2, and Cygwin. http​://qa.perl.org
http​://mirrors.develooper.com/hpux/ http​://www.test-smoke.org
  http​://www.goldmark.org/jeff/stupid-disclaimers/

@p5pRT
Copy link
Author

p5pRT commented Nov 18, 2006

From @demerphq

On Sun Dec 05 03​:50​:40 2004, david@​landgren.net wrote​:

david@​landgren.net (via RT) wrote​:

# New Ticket Created by david@​landgren.net
# Please include the string​: [perl #32840]
# in the subject line of all future correspondence about this issue.
# <URL​: http​://rt.perl.org​:80/rt3/Ticket/Display.html?id=32840 >

[...]

There do not appear to be any tests that check how $^R should
behave. The following file is an attempt to improve matters.

Late night bad wording. There are indeed tests for $^R in t/op/pat.t but
they don't exercise patterns with groupings.

Playing around some more, the following match, but $^R does not contain
what is expected​:

$^R = undef;
ok( 'ac' =~ /^a(?{30})(?​:b(?{31})|c(?{32}))?/, 'ac =~ a(?​:b|c)?' );
ok( $^R == 32, '$^R == 32' );

$^R = undef;
ok( 'abbb' =~ /^a(?{36})(?​:b(?{37})|c(?{38}))+/, 'abbbb =~ a(?​:b|c)+' );
ok( $^R == 37, '$^R == 37' ) or print "# \$^R=$^R\n";

This bug has been merged with 36909, and has been resolved by patch
#29308. The underlying issue was that CURLYX operands did a regcpblow()
without taking measures to preserve $^R.

The attached patch updates the tests in t/op/rxcode.t to remove todo's
and add additional tests from your ticket.

Cheers,
Yves

@p5pRT
Copy link
Author

p5pRT commented Nov 18, 2006

From @demerphq

de-todo_rxcode.patch
Index: 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 :

@p5pRT
Copy link
Author

p5pRT commented Nov 18, 2006

@demerphq - Status changed from 'open' to 'resolved'

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

1 participant