# 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" } }