blob: 9a473ef46c806ddc6ec31d7e8173b26dd5982b5a (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
# This file contains a top-level script to run all of the Tcl
# tests. Execute it by invoking "source all" when running tclTest
# in this directory.
#
# RCS: @(#) $Id: all,v 1.6 1999/04/16 01:25:55 stanton Exp $
set TESTS_DIR [file join [pwd] [file dirname [info script]]]
source [file join $TESTS_DIR defs]
set currentDir [pwd]
catch {array set flag $argv}
set requiredSourceFiles [list arc.tcl bugs.tcl butGeom2.tcl \
canvPsBmap.tcl canvPsText.tcl bevel.tcl butGeom.tcl \
canvPsArc.tcl canvPsGrph.tcl cmap.tcl filebox.test \
option.file1 option.file2 visual README defs]
#
# Set the TMP_DIR to pwd or the arg of -tmpdir, if given.
#
if {[info exists flag(-tmpdir)]} {
set TMP_DIR $flag(-tmpdir)
if {![file exists $TMP_DIR]} {
if {[catch {file mkdir $TMP_DIR} msg]} {
error "bad argument \"$flag(-tmpdir)\" to -tmpdir:\n$msg"
}
file mkdir $TMP_DIR
} elseif {![file isdir $TMP_DIR]} {
error "bad argument \"$flag(-tmpdir)\" to -tmpdir:\n$TMP_DIR is not a directory"
}
if {[string compare [file pathtype $TMP_DIR] absolute] != 0} {
set TMP_DIR [file join [pwd] $TMP_DIR]
}
cd $TMP_DIR
}
#
# copy each required source file to the current dir (if it's not already there).
#
if {[string compare $TESTS_DIR [pwd]] != 0} {
foreach file $requiredSourceFiles {
if {![file exists $file]} {
catch {file copy [file join $TESTS_DIR $file] .}
}
}
}
if {$tcl_platform(os) == "Win32s"} {
set globPattern [file join $TESTS_DIR *.tes]
} else {
set globPattern [file join $TESTS_DIR *.test]
}
foreach file [lsort [glob $globPattern]] {
set tail [file tail $file]
if {[string match l.*.test $tail]} {
# This is an SCCS lockfile; ignore it
continue
}
puts stdout $tail
if {[catch {source $file} msg]} {
puts stdout $msg
}
}
# remove the required source files from the current dir.
if {[info exists TMP_DIR]} {
foreach file $requiredSourceFiles {
catch {file delete -force $file}
}
cd $currentDir
}
# exit if Tk is running in non-interactive mode.
# Don't exit at the end of all the tests on the Mac, since
# this destroys the window that contains the test results...
if {([info exists tk_version] && !$tcl_interactive) \
|| [string compare $tcl_platform(platform) macintosh]} {
catch {destroy .}
exit
}
|
