# File : begin
if { [array get Draw_Groups "TOPOLOGY Check commands"] == "" } {
pload TOPTEST
pload VISUALIZATION
}
# to prevent loops limit to 16 minutes
cpulimit 1000
set rel_tol 0
set max_rel_tol_diff 0
# 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 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"
}
}