1# all.tcl --
2#
3# This file contains a top-level script to run all of the Tcl
4# tests.  Execute it by invoking "source all.test" when running tcltest
5# in this directory.
6#
7# Copyright (c) 1998-2000 by Ajuba Solutions
8# All rights reserved.
9#
10# RCS: @(#) $Id: all.tcl,v 1.2 2000/07/06 06:43:38 mmc Exp $
11
12package require tcltest
13namespace import -force ::tcltest::*
14
15# Look for the -exedir flag and find a suitable tclsh executable.
16
17if {(![info exists argv]) || ([llength $argv] < 1)} {
18    set flagArray {}
19} else {
20    set flagArray $argv
21}
22
23array set flag $flagArray
24if {[info exists flag(-exedir)]} {
25    set shell [lindex \
26	    [glob -nocomplain \
27	    [file join $flag(-exedir) wish*.bin] \
28	    [file join $flag(-exedir) wish*]] 0]
29} else {
30    set shell $::tcltest::tcltest
31}
32
33set ::tcltest::testSingleFile false
34
35# use [pwd] trick to expand relative file paths to absolute paths - MMc
36set cwd [pwd]
37cd [file dirname [info script]]
38set ::tcltest::testsDirectory [pwd]
39cd $cwd
40
41set logfile [file join $::tcltest::temporaryDirectory Log.txt]
42
43puts stdout "Using interp: $shell"
44puts stdout "Running tests in working dir: $::tcltest::testsDirectory"
45if {[llength $::tcltest::skip] > 0} {
46    puts stdout "Skipping tests that match:  $::tcltest::skip"
47}
48if {[llength $::tcltest::match] > 0} {
49    puts stdout "Only running tests that match:  $::tcltest::match"
50}
51
52if {[llength $::tcltest::skipFiles] > 0} {
53    puts stdout "Skipping test files that match:  $::tcltest::skipFiles"
54}
55if {[llength $::tcltest::matchFiles] > 0} {
56    puts stdout "Only sourcing test files that match:  $::tcltest::matchFiles"
57}
58
59set timeCmd {clock format [clock seconds]}
60puts stdout "Tests began at [eval $timeCmd]"
61
62# source each of the specified tests
63foreach file [lsort [::tcltest::getMatchingFiles]] {
64    set tail [file tail $file]
65    puts stdout $tail
66
67    # Change to the tests directory so the value of the following
68    # variable is set correctly when we spawn the child test processes
69
70    cd $::tcltest::testsDirectory
71    set cmd [concat [list | $shell $file] [split $argv] \
72	    [list -outfile $logfile]]
73    if {[catch {
74	set pipeFd [open $cmd "r"]
75	while {[gets $pipeFd line] >= 0} {
76	    puts $::tcltest::outputChannel $line
77	}
78	close $pipeFd
79    } msg]} {
80	# Print results to ::tcltest::outputChannel.
81	puts $::tcltest::outputChannel $msg
82    }
83
84    # Now concatenate the temporary log file to
85    # ::tcltest::outputChannel
86    if {[catch {
87	set fd [open $logfile "r"]
88	while {![eof $fd]} {
89	    gets $fd line
90	    if {![eof $fd]} {
91		if {[regexp {^([^:]+):\tTotal\t([0-9]+)\tPassed\t([0-9]+)\tSkipped\t([0-9]+)\tFailed\t([0-9]+)} $line null testFile Total Passed Skipped Failed]} {
92		    foreach index [list "Total" "Passed" "Skipped" \
93			    "Failed"] {
94			incr ::tcltest::numTests($index) [set $index]
95		    }
96		    incr ::tcltest::numTestFiles
97		    if {$Failed > 0} {
98			lappend ::tcltest::failFiles $testFile
99		    }
100		}
101		puts $::tcltest::outputChannel $line
102	    }
103	}
104	close $fd
105    } msg]} {
106	puts $::tcltest::outputChannel $msg
107    }
108}
109
110set numFailures [llength $::tcltest::failFiles]
111
112# cleanup
113puts stdout "\nTests ended at [eval $timeCmd]"
114::tcltest::cleanupTests 1
115
116if {$numFailures > 0} {
117    return -code error -errorcode $numFailures \
118	    -errorinfo "Found $numFailures test file failures"
119} else {
120    return
121}
122exit
123