forked from Kitware/VTK
-
Notifications
You must be signed in to change notification settings - Fork 0
/
prtImageTest.tcl
135 lines (112 loc) · 3.25 KB
/
prtImageTest.tcl
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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
package require vtk
# setup some common things for testing
vtkObject rtTempObject;
rtTempObject GlobalWarningDisplayOff;
vtkMath rtExMath
rtExMath RandomSeed 6
# create the testing class to do the work
vtkTesting rtTester
for {set i 1} {$i < [expr $argc - 1]} {incr i} {
rtTester AddArgument "[lindex $argv $i]"
}
set VTK_DATA_ROOT [rtTester GetDataRoot]
for {set i 1} {$i < [expr $argc - 1]} {incr i} {
if {[lindex $argv $i] == "-A"} {
foreach dir [split [lindex $argv [expr $i +1]] ":"] {
lappend auto_path $dir
}
}
}
vtkMPIController mpc
set gc [mpc GetGlobalController]
vtkCompositeRenderManager compManager
if { $gc != "" } {
set myProcId [$gc GetLocalProcessId]
set numProcs [$gc GetNumberOfProcesses]
compManager SetController $gc
} else {
set myProcId 0
set numProcs 1
}
proc ExitMaster { code } {
global numProcs
for { set i 1 } { $i < $numProcs } { incr i } {
# Send break to all the nodes
#puts "Send break to: $i"
set contr [ compManager GetController ]
catch [ $contr TriggerRMI $i [$contr GetBreakRMITag] ]
}
[mpc GetGlobalController] Finalize
mpc Delete
vtkCommand DeleteAllObjects
catch {destroy .top}
catch {destroy .geo}
exit $code
}
# load in the script
set file [lindex $argv 0]
if { $myProcId != 0 } {
#puts "Start reading script on satellite node"
source $file
compManager InitializeRMIs
#puts "Process RMIs"
[ compManager GetController ] ProcessRMIs
#puts "**********************************"
#puts "Done on the slave node"
#puts "**********************************"
[mpc GetGlobalController] Finalize
vtkCommand DeleteAllObjects
catch {destroy .top}
catch {destroy .geo}
exit 0
}
# set the default threshold, the Tcl script may change this
set threshold -1
if {[info commands wm] != ""} {
wm withdraw .
} else {
# There is no Tk. Help the tests run without it.
proc wm args {
puts "wm not implemented"
}
# The vtkinteraction package requires Tk but since Tk is not
# available it will never be used anyway. Just pretend it is
# already loaded so that tests that load it will not try to load Tk.
package provide vtkinteraction 5.3
}
# Run the test.
source $file
if {[info commands iren] == "iren"} {renWin Render}
# run the event loop quickly to map any tkwidget windows
update
# current directory
if {[rtTester IsValidImageSpecified] != 0} {
# look for a renderWindow ImageWindow or ImageViewer
# first check for some common names
if {[info commands renWin] == "renWin"} {
rtTester SetRenderWindow renWin
if {$threshold == -1} {
set threshold 10
}
} else {
if {$threshold == -1} {
set threshold 5
}
if {[info commands viewer] == "viewer"} {
rtTester SetRenderWindow [viewer GetRenderWindow]
viewer Render
} else {
if {[info commands imgWin] == "imgWin"} {
rtTester SetRenderWindow imgWin
imgWin Render
} else {
if {[info exists viewer]} {
rtTester SetRenderWindow [$viewer GetRenderWindow]
}
}
}
}
set rtResult [rtTester RegressionTest $threshold]
}
if {$rtResult == 0} {ExitMaster 1}
ExitMaster 0