0027368: Finding objects in vicinity of a ray
[occt.git] / tests / bugs / begin
CommitLineData
fa920fb1 1# File : begin
5ae01c85 2
fa920fb1 3if { [array get Draw_Groups "TOPOLOGY Check commands"] == "" } {
4 pload TOPTEST
5 pload VISUALIZATION
fa920fb1 6}
7
8# to prevent loops limit to 16 minutes
9cpulimit 1000
10
9753e6de 11# On Windows with VC, in typical configuration gl2ps is built with Release
12# mode only which will fail in Debug mode; add TODO for that case in order
13# to handle it once for all tests that can use vexport command
14if { [regexp {Debug mode} [dversion]] } {
15 puts "TODO ?#23540 windows: Error: export of image.*failed"
16 puts "TODO ?#23540 windows: Error: The file has been exported.*different size \[(\]0 "
17}
fa920fb1 18
19if { [info exists imagedir] == 0 } {
20 set imagedir .
21}
22if { [info exists test_image] == 0 } {
23 set test_image photo
24}
25
91322f44 26# Procedure to check equality of two reals with tolerance (relative and absolute)
27help checkarea {shape area_expected tol_abs tol_rel}
28proc checkarea {shape area_expected tol_abs tol_rel} {
29 # compute area with half of the relative tolerance
30 # to be used in comparison; 0.001 is added to avoid zero value
31 set prop [uplevel sprops $shape [expr 0.5 * abs($tol_rel) + 0.001]]
32
33 # get te value
34 if { ! [regexp {Mass\s*:\s*([0-9.e+-]+)} $prop res area] } {
35 puts "Error: cannot get area of the shape $shape"
36 return
37 }
f1aa2b62 38
91322f44 39 # compare with expected value
40 checkreal "area of $shape" $area $area_expected $tol_abs $tol_rel
41}
f1aa2b62 42
deb26df7
RL
43# Procedure to check if sequence of values in listval follows linear trend
44# adding the same delta on each step.
45#
46# The function does statistical estimation of the mean variation of the
47# values of the sequence, and dispersion, and returns true only if both
48# dispersion and deviation of the mean from expected delta are within
49# specified tolerance.
50#
51# If mean variation differs from expected delta on more than two dispersions,
52# the check fails and procedure raises error with specified message.
53#
54# Otherwise the procedure returns false meaning that more iterations are needed.
55# Note that false is returned in any case if length of listval is less than 3.
56#
57# See example of use to check memory leaks in bugs/caf/bug23489
58#
59proc checktrend {listval delta tolerance message} {
60 set nbval [llength $listval]
61 if { $nbval < 3} {
62 return 0
63 }
fa920fb1 64
deb26df7
RL
65 # calculate mean value
66 set mean 0.
67 set prev [lindex $listval 0]
68 foreach val [lrange $listval 1 end] {
69 set mean [expr $mean + ($val - $prev)]
70 set prev $val
71 }
9753e6de 72 set mean [expr $mean / ($nbval - 1)]
fa920fb1 73
deb26df7
RL
74 # calculate dispersion
75 set sigma 0.
76 set prev [lindex $listval 0]
77 foreach val [lrange $listval 1 end] {
78 set d [expr ($val - $prev) - $mean]
79 set sigma [expr $sigma + $d * $d]
80 set prev $val
81 }
9753e6de 82 set sigma [expr sqrt ($sigma / ($nbval - 2))]
fa920fb1 83
deb26df7
RL
84 puts "Checking trend: nb = $nbval, mean delta = $mean, sigma = $sigma"
85
86 # check if deviation is definitely too big
9753e6de 87 if { abs ($mean - $delta) > $tolerance + 2. * $sigma } {
deb26df7 88 puts "Checking trend failed: mean delta per step = $mean, sigma = $sigma, expected delta = $delta"
67a1064e 89 error "$message"
deb26df7
RL
90 }
91
92 # check if deviation is clearly within a range
93 return [expr abs ($mean - $delta) <= $sigma && $sigma <= $tolerance]
94}
74f764ba 95
96# Check if area of triangles is valid
97proc CheckTriArea {shape {eps 0}} {
98 upvar #0 $shape result
99 set area [triarea result $eps]
100 set t_area [lindex $area 0]
101 set g_area [expr abs([lindex $area 1])]
102 puts "area by triangles: $t_area"
103 puts "area by geometry: $g_area"
104 expr ($t_area - $g_area) / $g_area * 100
105}
02effd35 106
74da0216 107# Check expected time
108proc checktime {value expected tol_rel message} {
109 set t1 [expr ${value} - ${expected}]
110 set t2 [expr ${expected} * abs (${tol_rel})]
111
112 if { abs (${t1}) <= ${t2} } {
113 puts "OK. ${message}, ${value} seconds, is equal to expected time - ${expected} seconds"
114 } elseif {${t1} > ${t2}} {
115 puts "Error. ${message}, ${value} seconds, is more than expected time - ${expected} seconds"
116 } else {
117 puts "Improvement. ${message}, ${value} seconds, is less than expected time - ${expected} seconds"
118 }
119}