diff options
author | Steve Bennett <steveb@workware.net.au> | 2010-12-14 10:43:26 +1000 |
---|---|---|
committer | Steve Bennett <steveb@workware.net.au> | 2010-12-14 11:01:28 +1000 |
commit | 06256311b1367669e5983d2dd92a0a8c0ac3661e (patch) | |
tree | 661bdc96ed7164e2df808a85d2d80bcc3513d64c /tests | |
parent | 7e50b8cbb20c3cee9193249d0150aa6f5cc778ee (diff) | |
download | jimtcl-06256311b1367669e5983d2dd92a0a8c0ac3661e.zip jimtcl-06256311b1367669e5983d2dd92a0a8c0ac3661e.tar.gz jimtcl-06256311b1367669e5983d2dd92a0a8c0ac3661e.tar.bz2 |
Fix constraint checking
This was completely wrong. The arg order was wrong such that
when test constraints were specifed the test was always skipped!
Signed-off-by: Steve Bennett <steveb@workware.net.au>
Diffstat (limited to 'tests')
-rw-r--r-- | tests/jim.test | 6 | ||||
-rw-r--r-- | tests/string.test | 2 | ||||
-rw-r--r-- | tests/testing.tcl | 8 |
3 files changed, 10 insertions, 6 deletions
diff --git a/tests/jim.test b/tests/jim.test index 1d477e2..419e044 100644 --- a/tests/jim.test +++ b/tests/jim.test @@ -2515,12 +2515,12 @@ test switch-4.5 {error in default command} { } {1 switch2} test switch-5.1 {errors in -regexp matching} regexp { - list [catch {switch -regexp aaaab { + catch {switch -regexp aaaab { *b {concat glob} aaaab {concat exact} default {concat none} - }} msg] $msg -} {1 {couldn't compile regular expression pattern: quantifier operand invalid}} + }} msg +} 1 test switch-6.1 {backslashes in patterns} { switch -exact {\a\$\.\[} { diff --git a/tests/string.test b/tests/string.test index eecd18e..72edf32 100644 --- a/tests/string.test +++ b/tests/string.test @@ -622,7 +622,7 @@ test string-11.49 {string match, *special case} { string match "?\\*" "a*" } 1 # I don't see why this shouldn't match. Ignored for jim -test string-11.50 {string match, *special case} jim { +test string-11.50 {string match, *special case} tcl { string match "\\" "\\" } 0 diff --git a/tests/testing.tcl b/tests/testing.tcl index 9532599..d5eedd3 100644 --- a/tests/testing.tcl +++ b/tests/testing.tcl @@ -103,19 +103,23 @@ proc testConstraint {constraint bool} { testConstraint {utf8} [expr {[string length "\xc2\xb5"] == 1}] testConstraint {references} [expr {[info commands ref] ne ""}] testConstraint {jim} 1 +testConstraint {tcl} 0 proc bytestring {x} { return $x } -proc test {id descr script {constraints {}} expected} { +proc test {id descr {constraints {}} script expected} { incr ::testinfo(numtests) if {$::testinfo(verbose)} { puts -nonewline "$id " } foreach c $constraints { - if {![info exists ::tcltest::testConstraints($c)]} { + if {[info exists ::tcltest::testConstraints($c)]} { + if {$::tcltest::testConstraints($c)} { + continue + } incr ::testinfo(numskip) if {$::testinfo(verbose)} { puts "SKIP" |