Make (*THEN) work as in Perl in subpatterns that do not contain | alternatives.

git-svn-id: svn://vcs.exim.org/pcre/code/trunk@716 2f5784b3-3f2a-0410-8824-cb99058d5e15

5 files changed, 369 insertions, 33 deletions

diff --git a/testdata/testinput11 b/testdata/testinput11
index f71b56a..198dbf2 100644
--- a/testdata/testinput11
+++ b/testdata/testinput11
@@ -495,9 +495,6 @@ however, we need the complication for Perl. ---/
 /(?>(*COMMIT)(yes|no)(*THEN)(*F))?/
   yes
 
-/^((yes|no)(*THEN)(*F))?/
-  yes
-
 /b?(*SKIP)c/
     bc
     abc
@@ -674,5 +671,100 @@ name)/K
     a
     ba
     bba 
+    
+/--- Checking revised (*THEN) handling ---/ 
+
+/--- Capture ---/
+
+/^.*? (a(*THEN)b) c/x
+    aabc
+
+/^.*? (a(*THEN)b|(*F)) c/x
+    aabc
+
+/^.*? ( (a(*THEN)b) | (*F) ) c/x
+    aabc
+
+/^.*? ( (a(*THEN)b) ) c/x
+    aabc
+
+/--- Non-capture ---/
+
+/^.*? (?:a(*THEN)b) c/x
+    aabc
+
+/^.*? (?:a(*THEN)b|(*F)) c/x
+    aabc
+
+/^.*? (?: (?:a(*THEN)b) | (*F) ) c/x
+    aabc
+
+/^.*? (?: (?:a(*THEN)b) ) c/x
+    aabc
+
+/--- Atomic ---/
+
+/^.*? (?>a(*THEN)b) c/x
+    aabc
+
+/^.*? (?>a(*THEN)b|(*F)) c/x
+    aabc
+
+/^.*? (?> (?>a(*THEN)b) | (*F) ) c/x
+    aabc
+
+/^.*? (?> (?>a(*THEN)b) ) c/x
+    aabc
+
+/--- Possessive capture ---/
+
+/^.*? (a(*THEN)b)++ c/x
+    aabc
+
+/^.*? (a(*THEN)b|(*F))++ c/x
+    aabc
+
+/^.*? ( (a(*THEN)b)++ | (*F) )++ c/x
+    aabc
+
+/^.*? ( (a(*THEN)b)++ )++ c/x
+    aabc
+
+/--- Possessive non-capture ---/
+
+/^.*? (?:a(*THEN)b)++ c/x
+    aabc
+
+/^.*? (?:a(*THEN)b|(*F))++ c/x
+    aabc
+
+/^.*? (?: (?:a(*THEN)b)++ | (*F) )++ c/x
+    aabc
+
+/^.*? (?: (?:a(*THEN)b)++ )++ c/x
+    aabc
+    
+/--- Condition assertion ---/
+
+/^(?(?=a(*THEN)b)ab|ac)/
+    ac
+ 
+/--- Condition ---/
+
+/^.*?(?(?=a)a|b(*THEN)c)/
+    ba
+
+/^.*?(?:(?(?=a)a|b(*THEN)c)|d)/
+    ba
+
+/^.*?(?(?=a)a(*THEN)b|c)/
+    ac
+
+/--- Assertion ---/
+
+/^.*(?=a(*THEN)b)/ 
+    aabc
+
+/------------------------------/
 
 /-- End of testinput11 --/
diff --git a/testdata/testinput2 b/testdata/testinput2
index d875cf8..b246cbe 100644
--- a/testdata/testinput2
+++ b/testdata/testinput2
@@ -3885,5 +3885,57 @@ with \Y. ---/
 
 /a(?:.)*?a/ims                                                                  
     \Mabbbbbbbbbbbbbbbbbbbbba
+    
+/a(?:.(*THEN))*?a/ims
+    \Mabbbbbbbbbbbbbbbbbbbbba
+
+/a(?:.(*THEN:ABC))*?a/ims
+    \Mabbbbbbbbbbbbbbbbbbbbba
+
+/-- These tests are in agreement with development Perl 5.015, which has fixed
+    some things, but they don't all work with 5.012, so they aren't in the
+    Perl-compatible tests. Those after the first come from Perl's own test
+    files. --/
+    
+/^((yes|no)(*THEN)(*F))?/
+  yes
+
+/(A (.*)   C? (*THEN)  | A D) (*FAIL)/x
+AbcdCBefgBhiBqz
+
+/(A (.*)   C? (*THEN)  | A D) z/x
+AbcdCBefgBhiBqz
+
+/(A (.*)   C? (*THEN)  | A D) \s* (*FAIL)/x
+AbcdCBefgBhiBqz
+
+/(A (.*)   C? (*THEN)  | A D) \s* z/x
+AbcdCBefgBhiBqz
+
+/(A (.*)   (?:C|) (*THEN)  | A D) (*FAIL)/x
+AbcdCBefgBhiBqz
+
+/(A (.*)   (?:C|) (*THEN)  | A D) z/x
+AbcdCBefgBhiBqz
+
+/(A (.*)   C{0,6} (*THEN)  | A D) (*FAIL)/x
+AbcdCBefgBhiBqz
+
+/(A (.*)   C{0,6} (*THEN)  | A D) z/x
+AbcdCBefgBhiBqz
+
+/(A (.*)   (CE){0,6} (*THEN)  | A D) (*FAIL)/x
+AbcdCEBefgBhiBqz
+
+/(A (.*)   (CE){0,6} (*THEN)  | A D) z/x
+AbcdCEBefgBhiBqz
+
+/(A (.*)   (CE*){0,6} (*THEN)  | A D) (*FAIL)/x
+AbcdCBefgBhiBqz
+
+/(A (.*)   (CE*){0,6} (*THEN)  | A D) z/x
+AbcdCBefgBhiBqz
+
+/-----------------------------------------------/  
 
 /-- End of testinput2 --/
diff --git a/testdata/testoutput10 b/testdata/testoutput10
index 02c3532..f66a12a 100644
--- a/testdata/testoutput10
+++ b/testdata/testoutput10
@@ -698,31 +698,31 @@ Memory allocation (code space): 40
 
 /abc(d|e)(*THEN)x(123(*THEN)4|567(b|q)(*THEN)xx)/B
 ------------------------------------------------------------------
-  0  79 Bra
+  0  73 Bra
   3     abc
   9   7 CBra 1
  14     d
  16   5 Alt
  19     e
  21  12 Ket
- 24     *THEN 24
- 27     x
- 29  16 CBra 2
- 34     123
- 40     *THEN 11
- 43     4
- 45  31 Alt
- 48     567
- 54   7 CBra 3
- 59     b
- 61   5 Alt
- 64     q
- 66  12 Ket
- 69     *THEN 24
- 72     xx
- 76  47 Ket
- 79  79 Ket
- 82     End
+ 24     *THEN
+ 25     x
+ 27  14 CBra 2
+ 32     123
+ 38     *THEN
+ 39     4
+ 41  29 Alt
+ 44     567
+ 50   7 CBra 3
+ 55     b
+ 57   5 Alt
+ 60     q
+ 62  12 Ket
+ 65     *THEN
+ 66     xx
+ 70  43 Ket
+ 73  73 Ket
+ 76     End
 ------------------------------------------------------------------
 
 /-- End of testinput10 --/
diff --git a/testdata/testoutput11 b/testdata/testoutput11
index b7fc5d8..4af2e92 100644
--- a/testdata/testoutput11
+++ b/testdata/testoutput11
@@ -959,10 +959,6 @@ No match
   yes
 No match
 
-/^((yes|no)(*THEN)(*F))?/
-  yes
- 0: 
-
 /b?(*SKIP)c/
     bc
  0: bc
@@ -1266,5 +1262,131 @@ name
  0: a
     bba 
  0: a
+    
+/--- Checking revised (*THEN) handling ---/ 
+
+/--- Capture ---/
+
+/^.*? (a(*THEN)b) c/x
+    aabc
+No match
+
+/^.*? (a(*THEN)b|(*F)) c/x
+    aabc
+ 0: aabc
+ 1: ab
+
+/^.*? ( (a(*THEN)b) | (*F) ) c/x
+    aabc
+ 0: aabc
+ 1: ab
+ 2: ab
+
+/^.*? ( (a(*THEN)b) ) c/x
+    aabc
+No match
+
+/--- Non-capture ---/
+
+/^.*? (?:a(*THEN)b) c/x
+    aabc
+No match
+
+/^.*? (?:a(*THEN)b|(*F)) c/x
+    aabc
+ 0: aabc
+
+/^.*? (?: (?:a(*THEN)b) | (*F) ) c/x
+    aabc
+ 0: aabc
+
+/^.*? (?: (?:a(*THEN)b) ) c/x
+    aabc
+No match
+
+/--- Atomic ---/
+
+/^.*? (?>a(*THEN)b) c/x
+    aabc
+No match
+
+/^.*? (?>a(*THEN)b|(*F)) c/x
+    aabc
+ 0: aabc
+
+/^.*? (?> (?>a(*THEN)b) | (*F) ) c/x
+    aabc
+ 0: aabc
+
+/^.*? (?> (?>a(*THEN)b) ) c/x
+    aabc
+No match
+
+/--- Possessive capture ---/
+
+/^.*? (a(*THEN)b)++ c/x
+    aabc
+No match
+
+/^.*? (a(*THEN)b|(*F))++ c/x
+    aabc
+ 0: aabc
+ 1: ab
+
+/^.*? ( (a(*THEN)b)++ | (*F) )++ c/x
+    aabc
+ 0: aabc
+ 1: ab
+ 2: ab
+
+/^.*? ( (a(*THEN)b)++ )++ c/x
+    aabc
+No match
+
+/--- Possessive non-capture ---/
+
+/^.*? (?:a(*THEN)b)++ c/x
+    aabc
+No match
+
+/^.*? (?:a(*THEN)b|(*F))++ c/x
+    aabc
+ 0: aabc
+
+/^.*? (?: (?:a(*THEN)b)++ | (*F) )++ c/x
+    aabc
+ 0: aabc
+
+/^.*? (?: (?:a(*THEN)b)++ )++ c/x
+    aabc
+No match
+    
+/--- Condition assertion ---/
+
+/^(?(?=a(*THEN)b)ab|ac)/
+    ac
+ 0: ac
+ 
+/--- Condition ---/
+
+/^.*?(?(?=a)a|b(*THEN)c)/
+    ba
+No match
+
+/^.*?(?:(?(?=a)a|b(*THEN)c)|d)/
+    ba
+ 0: ba
+
+/^.*?(?(?=a)a(*THEN)b|c)/
+    ac
+No match
+
+/--- Assertion ---/
+
+/^.*(?=a(*THEN)b)/ 
+    aabc
+ 0: a
+
+/------------------------------/
 
 /-- End of testinput11 --/
diff --git a/testdata/testoutput2 b/testdata/testoutput2
index 3c1da1b..da81ba4 100644
--- a/testdata/testoutput2
+++ b/testdata/testoutput2
@@ -11066,7 +11066,7 @@ No match, mark = B
  1: C
 MK: A
     D 
-No match
+No match, mark = B
 
 /(*MARK:A)(*THEN:B)(C|X)/KSS
     C
@@ -11231,7 +11231,7 @@ No match
  1: C
 MK: A
     D 
-No match
+No match, mark = B
 
 /A(*MARK:A)A+(*SKIP)(B|Z) | AC/xKS
     AAAC
@@ -11824,7 +11824,7 @@ No match
 
 /^.*?(?(?=a)a|b(*THEN)c)/
     ba
- 0: ba
+No match
 
 /^.*?(?(?=a)a|bc)/
     ba
@@ -11832,16 +11832,15 @@ No match
 
 /^.*?(?(?=a)a(*THEN)b|c)/
     ac
- 0: ac
+No match
 
 /^.*?(?(?=a)a(*THEN)b)c/
     ac
- 0: ac
+No match
 
 /^.*?(a(*THEN)b)c/
     aabc
- 0: aabc
- 1: ab
+No match
     
 /^.*? (?1) c (?(DEFINE)(a(*THEN)b))/x
     aabc
@@ -12331,5 +12330,76 @@ No need char
 Minimum match() limit = 65
 Minimum match() recursion limit = 2
  0: abbbbbbbbbbbbbbbbbbbbba
+    
+/a(?:.(*THEN))*?a/ims
+    \Mabbbbbbbbbbbbbbbbbbbbba
+Minimum match() limit = 86
+Minimum match() recursion limit = 45
+ 0: abbbbbbbbbbbbbbbbbbbbba
+
+/a(?:.(*THEN:ABC))*?a/ims
+    \Mabbbbbbbbbbbbbbbbbbbbba
+Minimum match() limit = 86
+Minimum match() recursion limit = 45
+ 0: abbbbbbbbbbbbbbbbbbbbba
+
+/-- These tests are in agreement with development Perl 5.015, which has fixed
+    some things, but they don't all work with 5.012, so they aren't in the
+    Perl-compatible tests. Those after the first come from Perl's own test
+    files. --/
+    
+/^((yes|no)(*THEN)(*F))?/
+  yes
+No match
+
+/(A (.*)   C? (*THEN)  | A D) (*FAIL)/x
+AbcdCBefgBhiBqz
+No match
+
+/(A (.*)   C? (*THEN)  | A D) z/x
+AbcdCBefgBhiBqz
+No match
+
+/(A (.*)   C? (*THEN)  | A D) \s* (*FAIL)/x
+AbcdCBefgBhiBqz
+No match
+
+/(A (.*)   C? (*THEN)  | A D) \s* z/x
+AbcdCBefgBhiBqz
+No match
+
+/(A (.*)   (?:C|) (*THEN)  | A D) (*FAIL)/x
+AbcdCBefgBhiBqz
+No match
+
+/(A (.*)   (?:C|) (*THEN)  | A D) z/x
+AbcdCBefgBhiBqz
+No match
+
+/(A (.*)   C{0,6} (*THEN)  | A D) (*FAIL)/x
+AbcdCBefgBhiBqz
+No match
+
+/(A (.*)   C{0,6} (*THEN)  | A D) z/x
+AbcdCBefgBhiBqz
+No match
+
+/(A (.*)   (CE){0,6} (*THEN)  | A D) (*FAIL)/x
+AbcdCEBefgBhiBqz
+No match
+
+/(A (.*)   (CE){0,6} (*THEN)  | A D) z/x
+AbcdCEBefgBhiBqz
+No match
+
+/(A (.*)   (CE*){0,6} (*THEN)  | A D) (*FAIL)/x
+AbcdCBefgBhiBqz
+No match
+
+/(A (.*)   (CE*){0,6} (*THEN)  | A D) z/x
+AbcdCBefgBhiBqz
+No match
+
+/-----------------------------------------------/  
 
 /-- End of testinput2 --/