0025624: Visualization - selection is incorrect in perspective mode in a specific...
[occt.git] / tests / bugs / begin
CommitLineData
fa920fb1 1# File : begin
2if { [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
11cpulimit 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
16if { [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
21if { [info exists imagedir] == 0 } {
22 set imagedir .
23}
24if { [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 29help checkreal {name value expected tol_abs tol_rel}
c2f5c748 30proc 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)
40help checkarea {shape area_expected tol_abs tol_rel}
41proc 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#
72proc 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
110proc 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 121proc 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
147proc 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
161proc 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
172 foreach Entity ${EntityList} {
173 set expr_string "${Entity} +: +(\[-0-9.+eE\]+)"
174 if { [regexp "${expr_string}" ${nbshapes_expected_s} full nb_entity1] > 0 } {
175 if { [regexp "${expr_string}" ${nb_info} full nb_entity2] > 0 } {
176 if { ${nb_entity2} != ${nb_entity1} } {
177 puts "Error : ${message} is WRONG because number of ${Entity} entities is ${nb_entity2} while ${nb_entity1} is expected"
178 } else {
179 puts "OK : ${message} is GOOD because number of ${Entity} entities is equal to number of expected ${Entity} entities"
180 }
181 }
182 }
183 }
184}