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
|
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: samples.tcl,v 1.3 2002/11/13 21:12:18 idiscovery Exp $
#
# samples.tcl --
#
# Tests all the sample programs in the demo/samples directory.
#
#
# Copyright (c) 1996, Expert Interface Technologies
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
proc About {} {
return "Testing all the sample programs in the demo/samples directory"
}
proc Test {} {
global samples_dir demo_dir tix_library
TestBlock samples-1.0 "Finding the demo directory" {
foreach dir "$tix_library/demos $tix_library/../demos ../../demos ../demos demos" {
if {[file exists $dir] && [file isdir $dir]} {
set pwd [pwd]
cd $dir
set demo_dir [pwd]
set samples_dir [pwd]/samples
cd $pwd
break
}
}
}
if {![info exists samples_dir]} {
puts "Cannot find demos directory. Sample tests are skipped"
return
} else {
puts "loading demos from $demo_dir"
}
TestBlock samples-1.1 "Running widget demo" {
if {[file exists [set file [file join $demo_dir tixwidgets.tcl]]]} {
uplevel #0 [list source $file]
tixDemo:SelfTest
}
}
if {![file exists [set file [file join $samples_dir AllSampl.tcl]]]} {
return
}
uplevel #0 [list source $file]
ForAllSamples root "" Test_Sample
}
proc Test_Sample {token type text dest} {
global samples_dir tix_demo_running
set tix_demo_running 1
if {$type == "f"} {
set w .sampl_top
TestBlock samples-2-$dest "Loading sample $dest" {
uplevel #0 source [list $samples_dir/$dest]
toplevel $w
wm geometry $w +100+100
wm title $w $text
RunSample $w
update
}
catch {
destroy $w
}
}
}
|
