source: trunk/base/src/registry2.0/tests/common.tcl @ 27518

Last change on this file since 27518 was 27518, checked in by sfiera@…, 10 years ago

Committing registry2.0 to local branch

File size: 1.4 KB
Line 
1# Common functions for test cases
2
3proc test {condition} {
4    uplevel 1 "\
5        puts -nonewline {checking if $condition... }
6        if {\[catch {
7                if {$condition} { \n\
8                    puts yes
9                } else { \n\
10                    puts no \n\
11                    exit 1 \n\
12                } \n\
13            } msg\]} { \n\
14                puts \"caught error: \$msg\" \n\
15                exit 1 \n\
16            }"
17}
18
19proc test_equal {statement value} {
20    uplevel 1 "\
21        puts -nonewline {checking if $statement == \"$value\"... }
22        if {\[catch {
23                set actual $statement
24                if {\$actual == \[subst {$value}\]} { \n\
25                    puts yes
26                } else { \n\
27                    puts \"no (was \$actual)\" \n\
28                    exit 1 \n\
29                } \n\
30            } msg\]} { \n\
31                puts \"caught error: \$msg\" \n\
32                exit 1 \n\
33            }"
34}
35
36proc test_throws {statement error} {
37    uplevel 1 "\
38        puts -nonewline {checking if $statement throws $error... }
39        if {\[catch {$statement} error\]} { \n\
40            if {\$::errorCode == {$error}} {
41                puts yes
42            } else {
43                puts \"no (threw \$::errorCode instead)\" \n\
44                exit 1 \n\
45            } \n\
46        } else { \n\
47            puts {no (did not throw)} \n\
48            exit 1 \n\
49        }"
50}
51
Note: See TracBrowser for help on using the repository browser.