Commit | Line | Data |
---|---|---|
fa920fb1 | 1 | # File : begin |
2 | if { [array get Draw_Groups "TOPOLOGY Check commands"] == "" } { | |
3 | pload TOPTEST | |
4 | pload VISUALIZATION | |
5 | # set env(CSF_DrawPluginQADefaults) $env(CASROOT)/src/DrawResources/. | |
6 | # pload QAcommands | |
7 | # pload -DrawPluginQA QAcommands | |
8 | } | |
9 | ||
10 | # to prevent loops limit to 16 minutes | |
11 | cpulimit 1000 | |
12 | ||
9753e6de | 13 | # On Windows with VC, in typical configuration gl2ps is built with Release |
14 | # mode only which will fail in Debug mode; add TODO for that case in order | |
15 | # to handle it once for all tests that can use vexport command | |
16 | if { [regexp {Debug mode} [dversion]] } { | |
17 | puts "TODO ?#23540 windows: Error: export of image.*failed" | |
18 | puts "TODO ?#23540 windows: Error: The file has been exported.*different size \[(\]0 " | |
19 | } | |
fa920fb1 | 20 | |
21 | if { [info exists imagedir] == 0 } { | |
22 | set imagedir . | |
23 | } | |
24 | if { [info exists test_image] == 0 } { | |
25 | set test_image photo | |
26 | } | |
27 | ||
c2f5c748 | 28 | # Procedure to check equality of two reals with tolerance (relative and absolute) |
91322f44 | 29 | help checkreal {name value expected tol_abs tol_rel} |
c2f5c748 | 30 | proc checkreal {name value expected tol_abs tol_rel} { |
31 | if { abs ($value - $expected) > $tol_abs + $tol_rel * abs ($expected) } { | |
32 | puts "Error: $name = $value is not equal to expected $expected" | |
33 | } else { | |
34 | puts "Check of $name OK: value = $value, expected = $expected" | |
35 | } | |
36 | return | |
37 | } | |
38 | ||
91322f44 | 39 | # Procedure to check equality of two reals with tolerance (relative and absolute) |
40 | help checkarea {shape area_expected tol_abs tol_rel} | |
41 | proc checkarea {shape area_expected tol_abs tol_rel} { | |
42 | # compute area with half of the relative tolerance | |
43 | # to be used in comparison; 0.001 is added to avoid zero value | |
44 | set prop [uplevel sprops $shape [expr 0.5 * abs($tol_rel) + 0.001]] | |
45 | ||
46 | # get te value | |
47 | if { ! [regexp {Mass\s*:\s*([0-9.e+-]+)} $prop res area] } { | |
48 | puts "Error: cannot get area of the shape $shape" | |
49 | return | |
50 | } | |
f1aa2b62 | 51 | |
91322f44 | 52 | # compare with expected value |
53 | checkreal "area of $shape" $area $area_expected $tol_abs $tol_rel | |
54 | } | |
f1aa2b62 | 55 | |
deb26df7 RL |
56 | # Procedure to check if sequence of values in listval follows linear trend |
57 | # adding the same delta on each step. | |
58 | # | |
59 | # The function does statistical estimation of the mean variation of the | |
60 | # values of the sequence, and dispersion, and returns true only if both | |
61 | # dispersion and deviation of the mean from expected delta are within | |
62 | # specified tolerance. | |
63 | # | |
64 | # If mean variation differs from expected delta on more than two dispersions, | |
65 | # the check fails and procedure raises error with specified message. | |
66 | # | |
67 | # Otherwise the procedure returns false meaning that more iterations are needed. | |
68 | # Note that false is returned in any case if length of listval is less than 3. | |
69 | # | |
70 | # See example of use to check memory leaks in bugs/caf/bug23489 | |
71 | # | |
72 | proc checktrend {listval delta tolerance message} { | |
73 | set nbval [llength $listval] | |
74 | if { $nbval < 3} { | |
75 | return 0 | |
76 | } | |
fa920fb1 | 77 | |
deb26df7 RL |
78 | # calculate mean value |
79 | set mean 0. | |
80 | set prev [lindex $listval 0] | |
81 | foreach val [lrange $listval 1 end] { | |
82 | set mean [expr $mean + ($val - $prev)] | |
83 | set prev $val | |
84 | } | |
9753e6de | 85 | set mean [expr $mean / ($nbval - 1)] |
fa920fb1 | 86 | |
deb26df7 RL |
87 | # calculate dispersion |
88 | set sigma 0. | |
89 | set prev [lindex $listval 0] | |
90 | foreach val [lrange $listval 1 end] { | |
91 | set d [expr ($val - $prev) - $mean] | |
92 | set sigma [expr $sigma + $d * $d] | |
93 | set prev $val | |
94 | } | |
9753e6de | 95 | set sigma [expr sqrt ($sigma / ($nbval - 2))] |
fa920fb1 | 96 | |
deb26df7 RL |
97 | puts "Checking trend: nb = $nbval, mean delta = $mean, sigma = $sigma" |
98 | ||
99 | # check if deviation is definitely too big | |
9753e6de | 100 | if { abs ($mean - $delta) > $tolerance + 2. * $sigma } { |
deb26df7 | 101 | puts "Checking trend failed: mean delta per step = $mean, sigma = $sigma, expected delta = $delta" |
67a1064e | 102 | error "$message" |
deb26df7 RL |
103 | } |
104 | ||
105 | # check if deviation is clearly within a range | |
106 | return [expr abs ($mean - $delta) <= $sigma && $sigma <= $tolerance] | |
107 | } | |
74f764ba | 108 | |
109 | # Check if area of triangles is valid | |
110 | proc CheckTriArea {shape {eps 0}} { | |
111 | upvar #0 $shape result | |
112 | set area [triarea result $eps] | |
113 | set t_area [lindex $area 0] | |
114 | set g_area [expr abs([lindex $area 1])] | |
115 | puts "area by triangles: $t_area" | |
116 | puts "area by geometry: $g_area" | |
117 | expr ($t_area - $g_area) / $g_area * 100 | |
118 | } | |
02effd35 | 119 | |
120 | # Check if list of xdistcs-command is valid | |
e8feb725 | 121 | proc checkList {List Tolerance D_good Limit_Tol} { |
02effd35 | 122 | set L1 [llength ${List}] |
123 | set L2 10 | |
124 | set L3 5 | |
125 | set N [expr (${L1} - ${L2})/${L3} + 1] | |
126 | ||
127 | for {set i 1} {${i} <= ${N}} {incr i} { | |
128 | set j1 [expr ${L2} + (${i}-1)*${L3}] | |
129 | set j2 [expr ${j1} + 2] | |
130 | set T [lindex ${List} ${j1}] | |
131 | set D [lindex ${List} ${j2}] | |
132 | #puts "i=${i} j1=${j1} j2=${j2} T=${T} D=${D}" | |
133 | if { [expr abs(${D} - ${D_good})] > ${Tolerance} } { | |
e8feb725 | 134 | puts "Error : T=${T} D=${D}" |
135 | } | |
136 | ||
137 | if { ${Tolerance} > ${Limit_Tol} } { | |
138 | if { [expr abs(${D} - ${D_good})] > ${Limit_Tol} | |
139 | && [expr abs(${D} - ${D_good})] <= ${Tolerance} } { | |
140 | puts "Attention (critical value of tolerance) : T=${T} D=${D}" | |
141 | } | |
02effd35 | 142 | } |
143 | } | |
144 | } | |
558e68ea | 145 | |
74da0216 | 146 | # Check expected time |
147 | proc checktime {value expected tol_rel message} { | |
148 | set t1 [expr ${value} - ${expected}] | |
149 | set t2 [expr ${expected} * abs (${tol_rel})] | |
150 | ||
151 | if { abs (${t1}) <= ${t2} } { | |
152 | puts "OK. ${message}, ${value} seconds, is equal to expected time - ${expected} seconds" | |
153 | } elseif {${t1} > ${t2}} { | |
154 | puts "Error. ${message}, ${value} seconds, is more than expected time - ${expected} seconds" | |
155 | } else { | |
156 | puts "Improvement. ${message}, ${value} seconds, is less than expected time - ${expected} seconds" | |
157 | } | |
158 | } | |
159 | ||
558e68ea | 160 | # Procedure to check result of nbshapes command |
161 | proc checknbshapes { res nbshapes_expected_s count_locations message} { | |
162 | ||
163 | upvar $res shape | |
164 | if { ${count_locations} == 0 } { | |
165 | set nb_info [nbshapes shape] | |
166 | } else { | |
167 | set nb_info [nbshapes shape -t] | |
168 | } | |
169 | ||
170 | set EntityList {VERTEX EDGE WIRE FACE SHELL SOLID COMPSOLID COMPOUND SHAPE} | |
171 | ||
19589673 | 172 | puts "Checking $message" |
558e68ea | 173 | foreach Entity ${EntityList} { |
174 | set expr_string "${Entity} +: +(\[-0-9.+eE\]+)" | |
175 | if { [regexp "${expr_string}" ${nbshapes_expected_s} full nb_entity1] > 0 } { | |
176 | if { [regexp "${expr_string}" ${nb_info} full nb_entity2] > 0 } { | |
177 | if { ${nb_entity2} != ${nb_entity1} } { | |
19589673 | 178 | puts "Error: number of ${Entity} entities is wrong: ${nb_entity2} while ${nb_entity1} is expected" |
558e68ea | 179 | } else { |
19589673 | 180 | puts "OK: number of ${Entity} entities is as expected: ${nb_entity2}" |
558e68ea | 181 | } |
182 | } | |
183 | } | |
184 | } | |
185 | } |