0026855: Draw commands to debug Boolean Operations Algorithm
[occt.git] / tests / bugs / begin
1 # File : begin
2
3 if { [array get Draw_Groups "TOPOLOGY Check commands"] == "" } {
4     pload TOPTEST
5     pload VISUALIZATION
6 #    set env(CSF_DrawPluginQADefaults) $env(CASROOT)/src/DrawResources/.
7 #    pload QAcommands
8 #    pload -DrawPluginQA QAcommands
9 }
10
11 # to prevent loops limit to 16 minutes
12 cpulimit 1000
13
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
17 if { [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 }
21
22 if { [info exists imagedir] == 0 } {
23    set imagedir .
24 }
25 if { [info exists test_image] == 0 } {
26    set test_image photo
27 }
28
29 # Procedure to check equality of two reals with tolerance (relative and absolute)
30 help checkarea {shape area_expected tol_abs tol_rel}
31 proc 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     }
41
42     # compare with expected value
43     checkreal "area of $shape" $area $area_expected $tol_abs $tol_rel
44 }
45
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 #
62 proc checktrend {listval delta tolerance message} {
63     set nbval [llength $listval]
64     if { $nbval < 3} {
65         return 0
66     }
67
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     }
75     set mean [expr $mean / ($nbval - 1)]
76
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     }
85     set sigma [expr sqrt ($sigma / ($nbval - 2))]
86
87     puts "Checking trend: nb = $nbval, mean delta = $mean, sigma = $sigma"
88
89     # check if deviation is definitely too big
90     if { abs ($mean - $delta) > $tolerance + 2. * $sigma } {
91         puts "Checking trend failed: mean delta per step = $mean, sigma = $sigma, expected delta = $delta"
92         error "$message"
93     }
94
95     # check if deviation is clearly within a range
96     return [expr abs ($mean - $delta) <= $sigma && $sigma <= $tolerance]
97 }
98
99 # Check if area of triangles is valid
100 proc 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 }
109
110 # Check expected time
111 proc 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 }