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 #set script_dir [file dirname [info script]]/script
  14 # if { [info exist WorkDirectory] == 0 } {
  15 #    set WorkDirectory "/tmp"
  16 #    if { [array get env TEMP] != "" } {
  17 #       set WorkDirectory "$env(TEMP)"
  18 #       }
  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 proc checkreal {name value expected tol_abs tol_rel} {
  30     if { abs ($value - $expected) > $tol_abs + $tol_rel * abs ($expected) } {
  31         puts "Error: $name = $value is not equal to expected $expected"
  32     } else {
  33         puts "Check of $name OK: value = $value, expected = $expected"
  34     }
  35     return
  36 }
  37
  38 # Procedure to check if sequence of values in listval follows linear trend
  39 # adding the same delta on each step.
  40 #
  41 # The function does statistical estimation of the mean variation of the
  42 # values of the sequence, and dispersion, and returns true only if both
  43 # dispersion and deviation of the mean from expected delta are within
  44 # specified tolerance.
  45 #
  46 # If mean variation differs from expected delta on more than two dispersions,
  47 # the check fails and procedure raises error with specified message.
  48 #
  49 # Otherwise the procedure returns false meaning that more iterations are needed.
  50 # Note that false is returned in any case if length of listval is less than 3.
  51 #
  52 # See example of use to check memory leaks in bugs/caf/bug23489
  53 #
  54 proc checktrend {listval delta tolerance message} {
  55     set nbval [llength $listval]
  56     if { $nbval < 3} {
  57         return 0
  58     }
  59
  60     # calculate mean value
  61     set mean 0.
  62     set prev [lindex $listval 0]
  63     foreach val [lrange $listval 1 end] {
  64         set mean [expr $mean + ($val - $prev)]
  65         set prev $val
  66     }
  67     set mean [expr $mean / $nbval]
  68
  69     # calculate dispersion
  70     set sigma 0.
  71     set prev [lindex $listval 0]
  72     foreach val [lrange $listval 1 end] {
  73         set d [expr ($val - $prev) - $mean]
  74         set sigma [expr $sigma + $d * $d]
  75         set prev $val
  76     }
  77     set sigma [expr sqrt ($sigma / ($nbval - 1))]
  78
  79     puts "Checking trend: nb = $nbval, mean delta = $mean, sigma = $sigma"
  80
  81     # check if deviation is definitely too big
  82     if { abs ($mean - $delta) > 2. * $sigma } {
  83         puts "Checking trend failed: mean delta per step = $mean, sigma = $sigma, expected delta = $delta"
  84         error $message
  85     }
  86
  87     # check if deviation is clearly within a range
  88     return [expr abs ($mean - $delta) <= $sigma && $sigma <= $tolerance]
  89 }