Correction of testing case for issue 24374
[occt.git] / tests / bugs / begin
index 4ebd4de..9dad5fa 100755 (executable)
@@ -10,13 +10,13 @@ if { [array get Draw_Groups "TOPOLOGY Check commands"] == "" } {
 # 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)"
-#      }
-#    }
+# 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 .
@@ -61,50 +61,50 @@ proc checkpoint {coord_x coord_y rd_ch gr_ch bl_ch} {
     set mistake 0
     set i 0
     while { $mistake != 1 && $i <= 5 } {
-       set j 0
-       while { $mistake != 1 && $j <= 5 } {
-           set position_x [expr ${x_start} + $j]
-           set position_y [expr ${y_start} + $i]
-           puts $position_x
-           puts $position_y
-           global color2d
-           if { [info exists color2d] } {
-               set color [ QAAISGetPixelColor2d ${position_x} ${position_y} ]
-           } else {
-               set color [ QAGetPixelColor ${position_x} ${position_y} ]
-           }
-           regexp {RED +: +([-0-9.+eE]+)} $color full rd
-           regexp {GREEN +: +([-0-9.+eE]+)} $color full gr
-           regexp {BLUE +: +([-0-9.+eE]+)} $color full bl
-           set rd_int [expr int($rd * 1.e+05)]
-           set gr_int [expr int($gr * 1.e+05)]
-           set bl_int [expr int($bl * 1.e+05)]
-           
-           if { $rd_ch != 0 } {
-               set tol_rd [expr abs($rd_ch - $rd_int)/$rd_ch]
-           } else {
-               set tol_rd $rd_int
-           }
-           if { $gr_ch != 0 } {
-               set tol_gr [expr abs($gr_ch - $gr_int)/$gr_ch]
-           } else {
-               set tol_gr $gr_int
-           }
-           if { $bl_ch != 0 } {
-               set tol_bl [expr abs($bl_ch - $bl_int)/$bl_ch]
-           } else {
-               set tol_bl $bl_int
-           }
-
-           if { $tol_rd > 0.2 || $tol_gr > 0.2 || $tol_bl > 0.2 } {
-               puts "Warning : Point with true color was not found near default coordinates"
-               set mistake 0
-           } else {
-               set mistake 1
-           }
-           incr j
-       }
-       incr i
+      set j 0
+      while { $mistake != 1 && $j <= 5 } {
+          set position_x [expr ${x_start} + $j]
+          set position_y [expr ${y_start} + $i]
+          puts $position_x
+          puts $position_y
+          global color2d
+          if { [info exists color2d] } {
+            set color [ QAAISGetPixelColor2d ${position_x} ${position_y} ]
+          } else {
+            set color [ QAGetPixelColor ${position_x} ${position_y} ]
+          }
+          regexp {RED +: +([-0-9.+eE]+)} $color full rd
+          regexp {GREEN +: +([-0-9.+eE]+)} $color full gr
+          regexp {BLUE +: +([-0-9.+eE]+)} $color full bl
+          set rd_int [expr int($rd * 1.e+05)]
+          set gr_int [expr int($gr * 1.e+05)]
+          set bl_int [expr int($bl * 1.e+05)]
+            
+          if { $rd_ch != 0 } {
+            set tol_rd [expr abs($rd_ch - $rd_int)/$rd_ch]
+          } else {
+            set tol_rd $rd_int
+          }
+          if { $gr_ch != 0 } {
+            set tol_gr [expr abs($gr_ch - $gr_int)/$gr_ch]
+          } else {
+            set tol_gr $gr_int
+          }
+          if { $bl_ch != 0 } {
+            set tol_bl [expr abs($bl_ch - $bl_int)/$bl_ch]
+          } else {
+            set tol_bl $bl_int
+          }
+
+          if { $tol_rd > 0.2 || $tol_gr > 0.2 || $tol_bl > 0.2 } {
+            puts "Warning : Point with true color was not found near default coordinates"
+            set mistake 0
+          } else {
+            set mistake 1
+          }
+          incr j
+      }
+      incr i
     }
     return $mistake
 }
@@ -118,15 +118,15 @@ proc checkcolor { coord_x coord_y rd_get gr_get bl_get } {
     puts "BLUE color of RGB is $bl_get"
     
     if { $coord_x <= 1 || $coord_y <= 1 } {
-       puts "Error : minimal coordinate is x = 2, y = 2. But we have x = $coord_x y = $coord_y"
-       return -1
+      puts "Error : minimal coordinate is x = 2, y = 2. But we have x = $coord_x y = $coord_y"
+      return -1
     }
     global color2d
-       if { [info exists color2d] } {
-           set color [ QAAISGetPixelColor2d ${coord_x} ${coord_y} ]
-       } else {
-           set color [ QAGetPixelColor ${coord_x} ${coord_y} ]
-       }
+    if { [info exists color2d] } {
+      set color [ QAAISGetPixelColor2d ${coord_x} ${coord_y} ]
+    } else {
+      set color [ QAGetPixelColor ${coord_x} ${coord_y} ]
+    }
 
     regexp {RED +: +([-0-9.+eE]+)} $color full rd
     regexp {GREEN +: +([-0-9.+eE]+)} $color full gr
@@ -139,51 +139,51 @@ proc checkcolor { coord_x coord_y rd_get gr_get bl_get } {
     set bl_ch [expr int($bl_get * 1.e+05)]
     
     if { $rd_ch != 0 } {
-       set tol_rd [expr abs($rd_ch - $rd_int)/$rd_ch]
+      set tol_rd [expr abs($rd_ch - $rd_int)/$rd_ch]
     } else {
-       set tol_rd $rd_int
+      set tol_rd $rd_int
     }
     if { $gr_ch != 0 } {
-       set tol_gr [expr abs($gr_ch - $gr_int)/$gr_ch]
+      set tol_gr [expr abs($gr_ch - $gr_int)/$gr_ch]
     } else {
-       set tol_gr $gr_int
+      set tol_gr $gr_int
     }
     if { $bl_ch != 0 } {
-       set tol_bl [expr abs($bl_ch - $bl_int)/$bl_ch]
+      set tol_bl [expr abs($bl_ch - $bl_int)/$bl_ch]
     } else {
-       set tol_bl $bl_int
+      set tol_bl $bl_int
     }
     set status 0
     if { $tol_rd > 0.2 } {
-       puts "Warning : RED light of additive color model RGB is invalid"
-       set status 1
+      puts "Warning : RED light of additive color model RGB is invalid"
+      set status 1
     }
     if { $tol_gr > 0.2 } {
-       puts "Warning : GREEN light of additive color model RGB is invalid"
-       set status 1
+      puts "Warning : GREEN light of additive color model RGB is invalid"
+      set status 1
     }
     if { $tol_bl > 0.2 } {
-       puts "Warning : BLUE light of additive color model RGB is invalid"
-       set status 1
+      puts "Warning : BLUE light of additive color model RGB is invalid"
+      set status 1
     }
 
     if { $status != 0 } {
-       puts "Warning : Colors of default coordinate are not equal"
+      puts "Warning : Colors of default coordinate are not equal"
     }
 
     global stat
     if { $tol_rd > 0.2 || $tol_gr > 0.2 || $tol_bl > 0.2 } {
-       set info [checkpoint $coord_x $coord_y $rd_ch $gr_ch $bl_ch]
-       set stat [lindex $info end]
-       if { ${stat} != 1 } {
-           puts "Error : Colors are not equal in default coordinate and in the near coordinates too"
-           return $stat
-       } else {
-           puts "Point with valid color was found"
-           return $stat
-       }
+      set info [checkpoint $coord_x $coord_y $rd_ch $gr_ch $bl_ch]
+      set stat [lindex $info end]
+      if { ${stat} != 1 } {
+          puts "Error : Colors are not equal in default coordinate and in the near coordinates too"
+          return $stat
+      } else {
+          puts "Point with valid color was found"
+          return $stat
+      }
     } else {
-       set stat 1
+      set stat 1
     }
 }
 
@@ -217,7 +217,7 @@ proc checktrend {listval delta tolerance message} {
         set mean [expr $mean + ($val - $prev)]
         set prev $val
     }
-    set mean [expr $mean / $nbval]
+    set mean [expr $mean / ($nbval - 1)]
 
     # calculate dispersion
     set sigma 0.
@@ -227,12 +227,12 @@ proc checktrend {listval delta tolerance message} {
         set sigma [expr $sigma + $d * $d]
         set prev $val
     }
-    set sigma [expr sqrt ($sigma / ($nbval - 1))]
+    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) > 2. * $sigma } {
+    if { abs ($mean - $delta) > $tolerance + 2. * $sigma } {
         puts "Checking trend failed: mean delta per step = $mean, sigma = $sigma, expected delta = $delta"
         error "$message"
     }