tests/bugs/begin

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