This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
TRIE must use 'yes' state transitions when more than one match possible to ensure...
authorMarcus Holland-Moritz <mhx-perl@gmx.net>
Sat, 18 Aug 2007 01:55:37 +0000 (03:55 +0200)
committerYves Orton <demerphq@gmail.com>
Sat, 18 Aug 2007 11:15:19 +0000 (11:15 +0000)
Fix and test for issue raised in:

Subject: Very strange interaction between regex and lexical array in blead
Message-ID: <20070818015537.0088db31@r2d2>

p4raw-id: //depot/perl@31733

regexec.c
regnodes.h
t/op/pat.t

index 709eef2..1cd3857 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -2937,7 +2937,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
                    if ( got_wordnum ) {
                        if ( ! ST.accepted ) {
                            ENTER;
-                           SAVETMPS;
+                           /* SAVETMPS; */ /* XXX is this necessary? dmq */
                            bufflen = TRIE_INITAL_ACCEPT_BUFFLEN;
                            sv_accept_buff=newSV(bufflen *
                                            sizeof(reg_trie_accepted) - 1);
@@ -3148,18 +3148,10 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
                PL_reginput = (char *)ST.accept_buff[ best ].endpos;
                if ( !ST.jump || !ST.jump[ST.accept_buff[best].wordnum]) {
                    scan = ST.B;
-                   /* NOTREACHED */
                } else {
                    scan = ST.me + ST.jump[ST.accept_buff[best].wordnum];
-                   /* NOTREACHED */
-                }
-                if (has_cutgroup) {
-                    PUSH_YES_STATE_GOTO(TRIE_next, scan);    
-                    /* NOTREACHED */
-                } else {
-                    PUSH_STATE_GOTO(TRIE_next, scan);
-                    /* NOTREACHED */
                 }
+                PUSH_YES_STATE_GOTO(TRIE_next, scan);    
                 /* NOTREACHED */
            }
            /* NOTREACHED */
index 0a19006..1697a12 100644 (file)
@@ -625,7 +625,7 @@ EXTCONST char * const PL_reg_name[] = {
 EXTCONST char * PL_reg_extflags_name[];
 #else
 EXTCONST char * const PL_reg_extflags_name[] = {
-       /* Bits in extflags defined: 10111111111111111111111100111111 */
+       /* Bits in extflags defined: 11111111111111111111111100111111 */
        "ANCH_BOL",         /* 0x00000001 */
        "ANCH_MBOL",        /* 0x00000002 */
        "ANCH_SBOL",        /* 0x00000004 */
@@ -656,7 +656,7 @@ EXTCONST char * const PL_reg_extflags_name[] = {
        "SPLIT",            /* 0x08000000 */
        "COPY_DONE",        /* 0x10000000 */
        "TAINTED_SEEN",     /* 0x20000000 */
-       "UNUSED_BIT_30",    /* 0x40000000 */
+       "NULL",             /* 0x40000000 */
        "TAINTED",          /* 0x80000000 */
 };
 #endif /* DOINIT */
index f40154e..536c6cd 100755 (executable)
@@ -4459,6 +4459,25 @@ sub kt
     $_ = '123'; 
     iseq("$1",'abc',"/g leads to unsafe match vars: $1");
 }
+{
+    local $Message="Message-ID: <20070818091501.7eff4831@r2d2>";
+    my $str= "";
+    for(0..5){
+        my @x;
+        $str .= "@x"; # this should ALWAYS be the empty string
+        'a'=~/(a|)/;
+        push @x,1;
+    }
+    iseq(length($str),"0","Trie scope error, string should be empty");
+    $str="";
+    my @foo = ('a')x5;
+    for (@foo) {
+        my @bar;
+        $str .= "@bar";
+        s/a|/push @bar, 1/e;
+    }
+    iseq(length($str),"0","Trie scope error, string should be empty");
+}
 
 # Test counter is at bottom of file. Put new tests above here.
 #-------------------------------------------------------------------
@@ -4509,6 +4528,6 @@ ok($@=~/\QSequence \k... not terminated in regex;\E/);
 iseq(0+$::test,$::TestCount,"Got the right number of tests!");
 # Don't forget to update this!
 BEGIN {
-    $::TestCount = 1961;
+    $::TestCount = 1963;
     print "1..$::TestCount\n";
 }