occt/tests/bugs/begin

# 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

# 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 checkreal {name value expected tol_abs tol_rel}
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 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 if list of xdistcs-command is valid
proc checkList {List Tolerance D_good Limit_Tol} {
   set L1 [llength ${List}]
   set L2 10
   set L3 5
   set N [expr (${L1} - ${L2})/${L3} + 1]

   for {set i 1} {${i} <= ${N}} {incr i} {
      set j1 [expr ${L2} + (${i}-1)*${L3}]
      set j2 [expr ${j1} + 2]
      set T [lindex ${List} ${j1}]
      set D [lindex ${List} ${j2}]
      #puts "i=${i} j1=${j1} j2=${j2} T=${T} D=${D}"
      if { [expr abs(${D} - ${D_good})] > ${Tolerance} } {
         puts "Error : T=${T} D=${D}"
      }
      
      if { ${Tolerance} > ${Limit_Tol} } {
        if { [expr abs(${D} - ${D_good})] > ${Limit_Tol} 
             && [expr abs(${D} - ${D_good})] <= ${Tolerance} } {
           puts "Attention (critical value of tolerance) : T=${T} D=${D}"
        }
      }
   }
}

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

# Procedure to check result of nbshapes command
proc checknbshapes { res nbshapes_expected_s count_locations message} {

    upvar $res shape
    if { ${count_locations} == 0 } {
      set nb_info [nbshapes shape]
    } else {
      set nb_info [nbshapes shape -t]
    }

    set EntityList {VERTEX EDGE WIRE FACE SHELL SOLID COMPSOLID COMPOUND SHAPE}

    puts "Checking $message"
    foreach Entity ${EntityList} {
       set expr_string "${Entity} +: +(\[-0-9.+eE\]+)"
       if { [regexp "${expr_string}" ${nbshapes_expected_s} full nb_entity1] > 0 } {
       	  if { [regexp "${expr_string}" ${nb_info} full nb_entity2] > 0 } {
    	     if { ${nb_entity2} != ${nb_entity1} } {
             	puts "Error: number of ${Entity} entities is wrong: ${nb_entity2} while ${nb_entity1} is expected"
    	     } else {
             	puts "OK: number of ${Entity} entities is as expected: ${nb_entity2}"
    	     }
       	  }
       }
    }
}