source: branches/gsoc13-tests/tests/test.tcl @ 139170

Last change on this file since 139170 was 111298, checked in by cal@…, 7 years ago

regression tests: fix test output parsing using changes from src/macports1.0/tests/test.tcl

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