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