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