From: Yves Orton <demerphq@gmail.com>
Date: Sat, 10 Feb 2007 21:31:55 +0000 (+0100)
Subject: Re: [NL-PM] Fw: [PATCH - provisional] H. Merijn Brands idea of buffer numbering.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=76a476f9104f7947fe0fedc97cbf22a34bfffa87;p=p5sagit%2Fp5-mst-13.2.git

Re: [NL-PM] Fw: [PATCH - provisional] H. Merijn Brands idea of buffer numbering.
Message-ID: <9b18b3110702101231j5e91cc20g780a8c581af02dd5@mail.gmail.com>

p4raw-id: //depot/perl@30200
---

diff --git a/regcomp.c b/regcomp.c
index c526c3a..5f1efdc 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -5168,11 +5168,26 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth)
                             Perl_croak(aTHX_
                                 "panic: paren_name hash element allocation failed");
                         } else if ( SvPOK(sv_dat) ) {
-                            IV count=SvIV(sv_dat);
-                            I32 *pv=(I32*)SvGROW(sv_dat,SvCUR(sv_dat)+sizeof(I32)+1);
-                            SvCUR_set(sv_dat,SvCUR(sv_dat)+sizeof(I32));
-                            pv[count]=RExC_npar;
-                            SvIVX(sv_dat)++;
+                            /* (?|...) can mean we have dupes so scan to check
+                               its already been stored. Maybe a flag indicating
+                               we are inside such a construct would be useful,
+                               but the arrays are likely to be quite small, so
+                               for now we punt -- dmq */
+                            IV count = SvIV(sv_dat);
+                            I32 *pv = (I32*)SvPVX(sv_dat);
+                            IV i;
+                            for ( i = 0 ; i < count ; i++ ) {
+                                if ( pv[i] == RExC_npar ) {
+                                    count = 0;
+                                    break;
+                                }
+                            }
+                            if ( count ) {
+                                pv = (I32*)SvGROW(sv_dat, SvCUR(sv_dat) + sizeof(I32)+1);
+                                SvCUR_set(sv_dat, SvCUR(sv_dat) + sizeof(I32));
+                                pv[count] = RExC_npar;
+                                SvIVX(sv_dat)++;
+                            }
                         } else {
                             (void)SvUPGRADE(sv_dat,SVt_PVNV);
                             sv_setpvn(sv_dat, (char *)&(RExC_npar), sizeof(I32));
diff --git a/t/op/pat.t b/t/op/pat.t
index d7ace18..46900e8 100755
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -4299,6 +4299,22 @@ sub kt
     }
 }
 
+{
+    my $res="";
+
+    if ('1' =~ /(?|(?<digit>1)|(?<digit>2))/) {
+      $res = "@{$- {digit}}";
+    }
+    iseq($res,"1",
+        "Check that (?|...) doesnt cause dupe entries in the names array");
+    #---
+    $res="";
+    if ('11' =~ /(?|(?<digit>1)|(?<digit>2))(?&digit)/) {
+      $res = "@{$- {digit}}";
+    }
+    iseq($res, "1",
+        "Check that (?&..) to a buffer inside a (?|...) goes to the leftmost");
+}
 
 # Test counter is at bottom of file. Put new tests above here.
 #-------------------------------------------------------------------
@@ -4349,7 +4365,7 @@ 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 = 1636;
+    $::TestCount = 1638;
     print "1..$::TestCount\n";
 }