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
|
for {set i 0} {$i < [expr $argc - 1]} {incr i} {
if {[lindex $argv $i] == "-A"} {
set auto_path "$auto_path [lindex $argv [expr $i +1]]"
}
}
package require vtk
vtkObject a
a GlobalWarningDisplayOff
a Delete
set exceptions {
vtkLODProp3D-GetPickLODID
vtkObject-GetSuperClassName
vtkPropAssembly-GetBounds
vtkRenderWindow-GetEventPending
vtkSQLiteDatabase-GetQueryInstance
vtkXOpenGLRenderWindow-GetEventPending
vtkXMesaRenderWindow-GetEventPending
vtkMPICommunicator-GetWorldCommunicator
vtkMPICommunicator-GetLocalProcessId
vtkMPICommunicator-GetNumberOfProcesses
}
proc TestOne {cname} {
global exceptions
$cname b
puts "Testing Class $cname"
set methods [b ListMethods]
# look for a Get Set pair
set len [llength $methods]
for {set i 0} {$i < $len} {incr i} {
if {[regsub {^Get([A-za-z0-9]*)} [lindex $methods $i] {\1} name]} {
if {($i == $len - 1) || ($i < $len - 1 && [lindex $methods [expr $i + 1]] != "with")} {
if {[lsearch $exceptions "$cname-[lindex $methods $i]"] == -1} {
# invoke the GetMethod
puts " Invoking Get$name"
set tmp [b Get$name]
# find matching set method
for {set j 0} {$j < $len} {incr j} {
if {[regexp "^Set$name" [lindex $methods $j]]} {
if {$j < $len - 3 && [lindex $methods [expr $j + 2]] == "1"} {
puts " Invoking Set$name"
catch {b Set$name $tmp}
}
if {$j < $len - 3 && [lindex $methods [expr $j + 2]] > 1} {
puts " Invoking Set$name"
catch {eval b Set$name $tmp}
}
}
}
}
}
}
}
# Test the PrintRevisions method.
b PrintRevisions
b Delete
}
set classExceptions {
vtkCommand
vtkFileOutputWindow
vtkIndent
vtkOutputWindow
vtkParallelFactory
vtkPlanes
vtkProjectedPolyDataRayBounder
vtkRayCaster
vtkTimeStamp
vtkTkImageViewerWidget
vtkTkImageWindowWidget
vtkTkRenderWidget
vtkImageDataToTkPhoto
vtkViewRays
vtkWin32OutputWindow
vtkWin32ProcessOutputWindow
vtkXMLFileOutputWindow
}
proc rtSetGetTest { fileid } {
global classExceptions
# for every class
set all [lsort [info command vtk*]]
foreach a $all {
if {[lsearch $classExceptions $a] == -1} {
# test some set get methods
#puts "Testing -- $a"
TestOne $a
}
}
}
# All tests should end with the following...
puts "CTEST_FULL_OUTPUT (Avoid ctest truncation of output)"
rtSetGetTest stdout
exit
|
