diff options
author | dgp <dgp@noemail.net> | 2002-06-03 23:44:31 (GMT) |
---|---|---|
committer | dgp <dgp@noemail.net> | 2002-06-03 23:44:31 (GMT) |
commit | d761d35892793720175ee2b547eb49575d95af4d (patch) | |
tree | 1d5fa5d4fe765861fb412583c539f93246e58600 /tests/tcltest.test | |
parent | ff2f960af2a7d5da0567c8f9edb848ab509cd2bb (diff) | |
download | tcl-d761d35892793720175ee2b547eb49575d95af4d.zip tcl-d761d35892793720175ee2b547eb49575d95af4d.tar.gz tcl-d761d35892793720175ee2b547eb49575d95af4d.tar.bz2 |
* Implementation of TIP 85. Allows tcltest
users to add new legal values of the -match option to [test],
associating each with a Tcl command that does the matching of
expected results with actual results of tests. Thanks to
Arjen Markus. [Patch 521362]
FossilOrigin-Name: de2e3621bfacba7179231f834af890b47ee84dfe
Diffstat (limited to 'tests/tcltest.test')
-rwxr-xr-x | tests/tcltest.test | 119 |
1 files changed, 111 insertions, 8 deletions
diff --git a/tests/tcltest.test b/tests/tcltest.test index 736ef27..dca7cea 100755 --- a/tests/tcltest.test +++ b/tests/tcltest.test @@ -6,17 +6,13 @@ # Copyright (c) 2000 by Ajuba Solutions # All rights reserved. # -# RCS: @(#) $Id: tcltest.test,v 1.21 2002/05/10 18:47:11 dgp Exp $ +# RCS: @(#) $Id: tcltest.test,v 1.22 2002/06/03 23:44:32 dgp Exp $ -set tcltestVersion [package require tcltest] -namespace import -force ::tcltest::* - -if {[package vcompare $tcltestVersion 1.0] < 1} { - puts "Tests require that version 2.0 of tcltest be loaded." - puts "$tcltestVersion was loaded instead - tests will be skipped." - tcltest::cleanupTests +if {[catch {package require tcltest 2.1}]} { + puts "Skipping tests in [info script]. tcltest 2.1 required." return } +namespace import -force ::tcltest::* makeFile { package require tcltest @@ -1314,6 +1310,113 @@ test tcltest-23.5 {viewFile} { } } +# customMatch +test tcltest-24.0 { + tcltest::customMatch: syntax +} -body { + list [catch {customMatch} result] $result +} -result [list 1 "wrong # args: should be \"customMatch mode script\""] + +test tcltest-24.1 { + tcltest::customMatch: syntax +} -body { + list [catch {customMatch foo} result] $result +} -result [list 1 "wrong # args: should be \"customMatch mode script\""] + +test tcltest-24.2 { + tcltest::customMatch: syntax +} -body { + list [catch {customMatch foo bar baz} result] $result +} -result [list 1 "wrong # args: should be \"customMatch mode script\""] + +test tcltest-24.3 { + tcltest::customMatch: syntax +} -body { + list [catch {customMatch bad "a \{ b"} result] $result +} -result [list 1 "invalid customMatch script; can't evaluate after completion"] + +test tcltest-24.4 { + tcltest::test: valid -match values +} -body { + list [catch { + test tcltest-24.4.0 {} \ + -match ReallyBadMatchValueThatNoTestWillUse + } result] $result +} -match glob -result {1 *bad -match value*} + +test tcltest-24.5 { + tcltest::test: valid -match values +} -setup { + customMatch alwaysMatch "format 1 ;#" +} -body { + list [catch { + test tcltest-24.5.0 {} \ + -match ReallyBadMatchValueThatNoTestWillUse + } result] $result +} -match glob -result {1 *bad -match value*: must be *alwaysMatch,*} + +test tcltest-24.6 { + tcltest::customMatch: -match script that always matches +} -setup { + customMatch alwaysMatch "format 1 ;#" + set v [verbose] + verbose {} +} -body { + test tcltest-24.6.0 {} -match alwaysMatch -body {format 1} -result 0 +} -cleanup { + verbose $v +} -result {} -output {} -errorOutput {} + +test tcltest-24.7 { + tcltest::customMatch: replace default -exact matching +} -setup { + set saveExactMatchScript $::tcltest::CustomMatch(exact) + customMatch exact "format 1 ;#" + set v [verbose] + verbose {} +} -body { + test tcltest-24.7.0 {} -body {format 1} -result 0 +} -cleanup { + verbose $v + customMatch exact $saveExactMatchScript + unset saveExactMatchScript +} -result {} -output {} + +test tcltest-24.8 { + tcltest::customMatch: default -exact matching +} -setup { + set saveExactMatchScript $::tcltest::CustomMatch(exact) + customMatch exact [list ::string equal] + set v [verbose] + verbose {} +} -body { + test tcltest-24.8.0 {} -body {format 1} -result 0 +} -cleanup { + verbose $v + customMatch exact $saveExactMatchScript + unset saveExactMatchScript +} -match glob -result {} -output {*FAILED*Result was: +1*(exact matching): +0*} + +test tcltest-24.9 { + tcltest::customMatch: error during match +} -setup { + proc errorDuringMatch args {return -code error "match returned error"} + customMatch errorDuringMatch [namespace code errorDuringMatch] +} -body { + test tcltest-24.9.0 {} -match errorDuringMatch +} -match glob -result {} -output {*FAILED*match returned error*} + +test tcltest-24.10 { + tcltest::customMatch: bad return from match command +} -setup { + proc nonBooleanReturn args {return foo} + customMatch nonBooleanReturn [namespace code nonBooleanReturn] +} -body { + test tcltest-24.10.0 {} -match nonBooleanReturn +} -match glob -result {} -output {*FAILED*expected boolean value*} + # cleanup if {[file exists a.tmp]} { file delete -force a.tmp |