source: trunk/base/tests/test.tcl.in @ 140015

Last change on this file since 140015 was 125596, checked in by jmr@…, 6 years ago

always print details for tests that fail

File size: 3.6 KB
Line 
1set test_suite {
2    case-insensitive-deactivate
3    checksums-1
4    dependencies-a
5    dependencies-b
6    dependencies-c
7    dependencies-d
8    dependencies-e
9    envvariables
10    site-tags
11    statefile-unknown-version
12    statefile-version1
13    statefile-version1-outdated
14    statefile-version2
15    statefile-version2-invalid
16    statefile-version2-outdated
17    svn-and-patchsites
18    trace
19    universal
20    variants
21    xcodeversion
22}
23
24set arguments ""
25set test_name ""
26set color_out ""
27set err ""
28
29# Get tclsh path.
30set tcl "@TCLSH@"
31
32proc print_help {arg} {
33    if { $arg eq "tests" } {
34        puts "The list of available tests is:"
35        foreach test $::test_suite {
36            puts [puts -nonewline "  "]$test
37        }
38    } else {
39        puts "Usage: tclsh test.tcl \[-debug level\] \[-t test\] \[-l\]\n"
40        puts "  -debug LVL : sets the level of printed debug info \[0-3\]"
41        puts "  -t TEST    : run a specific test"
42        puts "  -nocolor   : disable color output (for automatic testing)"
43        puts "  -l         : print the list of available tests"
44        puts "  -h, -help  : print this message\n"
45    }
46}
47
48# Process args
49foreach arg $argv {
50    if { $arg eq "-h" || $arg eq "-help" } {
51        print_help ""
52        exit 0
53    } elseif { $arg eq "-debug" } {
54        set index [expr {[lsearch $argv $arg] + 1}]
55        set level [lindex $argv $index]
56        if { $level >= 0 && $level <= 3 } {
57            append arguments "-debug " $level
58        } else {
59            puts "Invalid debug level."
60            exit 1
61        }
62    } elseif { $arg eq "-t" } {
63        set index [expr {[lsearch $argv $arg] + 1}]
64        set test_name [lindex $argv $index]
65        set no 0
66        foreach test $test_suite {
67            if { $test_name != $test } {
68                set no [expr {$no + 1}]
69            }
70        }
71        if { $no == [llength $test_suite] } {
72            print_help tests
73            exit 1
74        }
75    } elseif { $arg eq "-l" } {
76        print_help tests
77        exit 0
78    } elseif { $arg eq "-nocolor" } {
79        set color_out "no"
80    }
81}
82
83
84# Run tests
85if {$test_name ne ""} {
86    cd test/$test_name
87
88    set result [exec $tcl test.tcl {*}$arguments 2>@stderr]
89    puts $result
90
91} else {
92    foreach test $test_suite {
93        cd test/$test
94   
95        set result [exec $tcl test.tcl {*}$arguments 2>@stderr]
96        set lastline [lindex [split $result "\n"] end]
97
98        if {[lrange [split $lastline "\t"] 1 1] != "Total"} {
99            set lastline [lindex [split $result "\n"] end-2]
100            set errmsg [lindex [split $result "\n"] end]
101        }
102
103        set splitresult [split $lastline "\t"]
104        set total [lindex $splitresult 2]
105        set pass [lindex $splitresult 4]
106        set skip [lindex $splitresult 6]
107        set fail [lindex $splitresult 8]
108
109        # Check for errors.
110        if { $fail != 0 } {
111            set err "yes"
112            puts $result
113        }
114
115        set out ""
116        if { ($fail != 0 || $skip != 0) && $color_out eq "" } {
117            # Color failed tests.
118            append out "\x1b\[1;31mTotal:" $total " Passed:" $pass " Failed:" $fail " Skipped:" $skip "  \x1b\[0m" $test
119        } else {
120            append out "Total:" $total " Passed:" $pass " Failed:" $fail " Skipped:" $skip "  " $test
121        }
122
123        # Print results and constrints for auto-skipped tests.
124        puts $out
125        if { $skip != 0 } {
126            set out "    Constraint: "
127            append out [string trim $errmsg "\t {}"]
128            puts $out
129        }
130   
131        cd ../..
132    }
133}
134
135# Return 1 if errors were found.
136if {$err ne ""} {
137    exit 1
138}
139
140return 0
Note: See TracBrowser for help on using the repository browser.