summaryrefslogtreecommitdiffstats
path: root/tests/reg.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/reg.test')
-rw-r--r--tests/reg.test61
1 files changed, 50 insertions, 11 deletions
diff --git a/tests/reg.test b/tests/reg.test
index de20e33..40efbdb 100644
--- a/tests/reg.test
+++ b/tests/reg.test
@@ -4,10 +4,9 @@
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-# All rights reserved.
+# Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
#
-# RCS: @(#) $Id: reg.test,v 1.2 1999/04/16 00:47:33 stanton Exp $
+# RCS: @(#) $Id: reg.test,v 1.3 1999/06/02 01:53:32 stanton Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
source [file join [pwd] [file dirname [info script]] defs.tcl]
@@ -55,6 +54,7 @@ set ::tcltest::testConfig(testregexp) \
# % force small state-set cache in matcher (to test cache replace)
# ^ beginning of string is not beginning of line
# $ end of string is not end of line
+# ? report information on partial and limited matches
#
# & test as both ARE and BRE
# b BRE
@@ -117,7 +117,7 @@ proc doing {major desc} {
if {$testbypassed != 0} {
puts stdout "!!! bypassed $testbypassed tests in\
- $major, `$description'"
+ $prefix, `$description'"
}
set prefix reg-$major
@@ -234,6 +234,8 @@ proc f {testid flags re target args} {
# match expected, internal routine that does the work
# parameters like the "real" routines except they don't have "opts",
# which is a possibly-empty list of switches for the regexp match attempt
+# The ! flag is used to indicate expected match failure (for REG_EXPECT,
+# which wants argument testing even in the event of failure).
proc matchexpected {opts testid flags re target args} {
global prefix description ask
@@ -270,9 +272,16 @@ proc matchexpected {opts testid flags re target args} {
if {[string first "o" $flags] >= 0} { ;# REG_NOSUB
set nsub 0 ;# unsigned value cannot be -1
}
+ if {[string first "?" $flags] >= 0} { ;# REG_EXPECT
+ incr nsub -1 ;# the extra does not count
+ }
set ecmd [concat $ecmd $names]
set erun "list \[$ecmd\] $refs"
- set result [concat [list 1] $args]
+ set retcode [list 1]
+ if {[string first "!" $flags] >= 0} {
+ set retcode [list 0]
+ }
+ set result [concat $retcode $args]
set info [list $nsub $infoflags]
lappend testid "compile"
@@ -293,6 +302,15 @@ proc i {args} {
eval matchexpected [linsert $args 0 [list "-indices"]]
}
+# partial match expected
+# p testno flags re target mat "" ...
+# Quirk: number of ""s must be one more than number of subREs.
+proc p {args} {
+ set f [lindex $args 1] ;# add ! flag
+ set args [lreplace $args 1 1 "!$f"]
+ eval matchexpected [linsert $args 0 [list "-indices"]]
+}
+
# test temporarily unimplemented
proc xx {args} {
global testbypassed
@@ -309,7 +327,7 @@ proc xx {args} {
# support functions and preliminary misc.
# This is sensitive to changes in message wording, but we really have to
# test the code->message expansion at least once.
-test regexp-0.1 "regexp error reporting" {
+test reg-0.1 "regexp error reporting" {
list [catch {regexp (*) ign} msg] $msg
} {1 {couldn't compile regular expression pattern: quantifier operand invalid}}
@@ -431,8 +449,8 @@ e 7 - "a{1" EBRACE
e 8 - "a{1n}" BADBR
m 9 BS "a{b" "a\{b" "a\{b"
m 10 BS "a{" "a\{" "a\{"
-m 11 bQ {a\{0,1\}b} cb b
-e 12 b {a\{0,1} EBRACE
+m 11 bQ "a\\{0,1\\}b" cb b
+e 12 b "a\\{0,1" EBRACE
e 13 - "a{0,1\\" BADBR
m 14 Q "a{0}b" ab b
m 15 Q "a{0,0}b" ab b
@@ -836,8 +854,11 @@ m 8 PQ "ab{2,4}?c" abbbbc abbbbc
doing 25 "mixed quantifiers"
-xx to be done, actually
-xx should include |
+# should include |
+m 1 PN {^(.*?)(a*)$} xyza xyza xyz a
+m 2 PN {^(.*?)(a*)$} xyzaa xyzaa xyz aa
+m 3 PN {^(.*?)(a*)$} xyz xyz xyz ""
+xx lots more to be done
@@ -886,7 +907,25 @@ i 12 %LP {\w+(abcdefghijklmnopqrst)?} xyzabcdefghijklmnopqrs \
-doing 29 "misc. oddities and old bugs"
+doing 29 "incomplete matches"
+p 1 ? def abc {3 2} ""
+p 2 ? bcd abc {1 2} ""
+p 3 ? abc abab {0 3} ""
+p 4 ? abc abdab {3 4} ""
+i 5 ? abc abc {0 2} {0 2}
+i 6 ? abc xyabc {2 4} {2 4}
+p 7 ? abc+ xyab {2 3} ""
+i 8 ? abc+ xyabc {2 4} {2 4}
+p 9 ?P abc+? xyab {2 3} ""
+# the retain numbers in these two may look wrong, but they aren't
+i 10 ?P abc+? xyabc {2 4} {5 4}
+i 11 ?P abc+? xyabcc {2 4} {6 5}
+i 12 ?P abc+? xyabcd {2 4} {6 5}
+i 13 ? abcd|bc xyabc {3 4} {2 4}
+
+
+
+doing 30 "misc. oddities and old bugs"
e 1 & *** BADRPT
m 2 N a?b* abb abb
m 3 N a?b* bb bb