source: trunk/base/src/tests/test.tcl @ 141366

Last change on this file since 141366 was 141366, checked in by raimue@…, 4 years ago

Unify test.tcl files into a single script at src/tests/test.tcl

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