tests/runall.tcl

   1 # Run all tests in the current directory
   2 #
   3 # Tests are run in a sub-interpreter (if possible) to avoid
   4 # interactions between tests.
   5
   6 lappend auto_path .
   7
   8 # In case interp is a module
   9 catch {package require interp}
  10
  11 if {[info commands interp] eq ""} {
  12         set rc 1
  13         foreach script [lsort [glob *.test]] {
  14                 if {[catch {
  15                         exec [info nameofexecutable] $script >@stdout 2>@stderr
  16                         set rc 0
  17                 } msg opts]} {
  18                         puts "Failed: $script"
  19                 }
  20         }
  21         exit $rc
  22 } else {
  23         array set total {pass 0 fail 0 skip 0 tests 0}
  24         foreach script [lsort [glob *.test]] {
  25                 set ::argv0 $script
  26
  27                 if {$script eq "signal.test"} {
  28                         # special case, can't run this in a child interpeter
  29                         catch -exit {
  30                                 source $script
  31                         }
  32                         foreach var {pass fail skip tests} {
  33                                 incr total($var) $testinfo(num$var)
  34                         }
  35                 } else {
  36                         set i [interp]
  37
  38                         foreach var {argv0 auto_path} {
  39                                 $i eval [list set $var [set ::$var]]
  40                         }
  41
  42                         # Run the test
  43                         catch -exit {$i eval source $script} msg opts
  44                         if {[info returncode $opts(-code)] eq "error"} {
  45                                 puts [format "%16s:   --- error ($msg)" $script]
  46                                 incr total(fail)
  47                         } elseif {[info return $opts(-code)] eq "exit"} {
  48                                 # if the test explicitly called exit 99,
  49                                 # it must be from a child process via os.fork, so
  50                                 # silently exit
  51                                 if {$msg eq "99"} {
  52                                         exit 0
  53                                 }
  54                         }
  55
  56                         # Extract the counts
  57                         foreach var {pass fail skip tests} {
  58                                 incr total($var) [$i eval "set testinfo(num$var)"]
  59                         }
  60                         $i delete
  61                 }
  62
  63                 stdout flush
  64         }
  65         puts [string repeat = 73]
  66         puts [format "%16s: Total %5d   Passed %5d  Skipped %5d  Failed %5d" \
  67                         Totals $total(tests) $total(pass) $total(skip) $total(fail)]
  68
  69         if {$total(fail)} {
  70                 exit 1
  71         }
  72 }