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