mirror of
https://git.dev.opencascade.org/repos/occt.git
synced 2025-04-03 17:56:21 +03:00
c2f5c74815
1. Fixed tests bugs caf bug350 and bug352 failing in Debug mode due to errors in QA code (removing items from the map during iteration). 2. Debug output messages are ignored in parse.rules in heal and bugs group to avoid false failures in Debug mode after changes made for #23609 and last integration of new tests. 3. Test bugs moddata buc60654 removed as duplicate of bug143. 4. Test bugs moddata bug143 fixed to compare real values properly. New command checkreal added for comparing reals with tolerance. 6. Test bugs caf bug114 is fixed to avoid use of OS-specific commands (command meminfo is used instead). Command checktrend is used to check for possible memory leak.
90 lines
2.8 KiB
Plaintext
Executable File
90 lines
2.8 KiB
Plaintext
Executable File
# 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
|
|
|
|
#set script_dir [file dirname [info script]]/script
|
|
# if { [info exist WorkDirectory] == 0 } {
|
|
# set WorkDirectory "/tmp"
|
|
# if { [array get env TEMP] != "" } {
|
|
# set WorkDirectory "$env(TEMP)"
|
|
# }
|
|
# }
|
|
|
|
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)
|
|
proc checkreal {name value expected tol_abs tol_rel} {
|
|
if { abs ($value - $expected) > $tol_abs + $tol_rel * abs ($expected) } {
|
|
puts "Error: $name = $value is not equal to expected $expected"
|
|
} else {
|
|
puts "Check of $name OK: value = $value, expected = $expected"
|
|
}
|
|
return
|
|
}
|
|
|
|
# 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]
|
|
|
|
# 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 - 1))]
|
|
|
|
puts "Checking trend: nb = $nbval, mean delta = $mean, sigma = $sigma"
|
|
|
|
# check if deviation is definitely too big
|
|
if { abs ($mean - $delta) > 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]
|
|
}
|