mirror of
https://git.dev.opencascade.org/repos/occt.git
synced 2025-08-14 13:30:48 +03:00
0023150: Command sewing produce incorrect results on test grid csw.
Test for sewing command were updated to check reference information. Commands for testing were moved to the file src/DrawResources/CheckCommands.tcl Documentation overview was updated.
This commit is contained in:
ski
bugmaster
437
src/DrawResources/CheckCommands.tcl
Normal file
437
src/DrawResources/CheckCommands.tcl
Normal file
@@ -0,0 +1,437 @@
|
||||
# Copyright (c) 2013-2014 OPEN CASCADE SAS
|
||||
#
|
||||
# This file is part of Open CASCADE Technology software library.
|
||||
#
|
||||
# This library is free software; you can redistribute it and/or modify it under
|
||||
# the terms of the GNU Lesser General Public License version 2.1 as published
|
||||
# by the Free Software Foundation, with special exception defined in the file
|
||||
# OCCT_LGPL_EXCEPTION.txt. Consult the file LICENSE_LGPL_21.txt included in OCCT
|
||||
# distribution for complete text of the license and disclaimer of any warranty.
|
||||
#
|
||||
# Alternatively, this file may be used under the terms of Open CASCADE
|
||||
# commercial license or contractual agreement.
|
||||
|
||||
############################################################################
|
||||
# This file defines scripts for verification of OCCT tests.
|
||||
# It provides top-level commands starting with 'check'.
|
||||
# Type 'help check*' to get their synopsys.
|
||||
# See OCCT Tests User Guide for description of the test system.
|
||||
#
|
||||
# Note: procedures with names starting with underscore are for internal use
|
||||
# inside the test system.
|
||||
############################################################################
|
||||
|
||||
help checkcolor {
|
||||
Check pixel color.
|
||||
Use: checkcolor x y red green blue
|
||||
x y - pixel coordinates
|
||||
red green blue - expected pixel color (values from 0 to 1)
|
||||
Function check color with tolerance (5x5 area)
|
||||
}
|
||||
# Procedure to check color using command vreadpixel with tolerance
|
||||
proc checkcolor { coord_x coord_y rd_get gr_get bl_get } {
|
||||
puts "Coordinate x = $coord_x"
|
||||
puts "Coordinate y = $coord_y"
|
||||
puts "RED color of RGB is $rd_get"
|
||||
puts "GREEN color of RGB is $gr_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
|
||||
}
|
||||
|
||||
set color ""
|
||||
catch { [set color "[vreadpixel ${coord_x} ${coord_y} rgb]"] }
|
||||
if {"$color" == ""} {
|
||||
puts "Error : Pixel coordinates (${position_x}; ${position_y}) are out of view"
|
||||
}
|
||||
set rd [lindex $color 0]
|
||||
set gr [lindex $color 1]
|
||||
set bl [lindex $color 2]
|
||||
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)]
|
||||
set rd_ch [expr int($rd_get * 1.e+05)]
|
||||
set gr_ch [expr int($gr_get * 1.e+05)]
|
||||
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]
|
||||
} 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
|
||||
}
|
||||
|
||||
set status 0
|
||||
if { $tol_rd > 0.2 } {
|
||||
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
|
||||
}
|
||||
if { $tol_bl > 0.2 } {
|
||||
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"
|
||||
}
|
||||
|
||||
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
|
||||
}
|
||||
} else {
|
||||
set stat 1
|
||||
}
|
||||
}
|
||||
|
||||
# Procedure to check color in the point near default coordinate
|
||||
proc _checkpoint {coord_x coord_y rd_ch gr_ch bl_ch} {
|
||||
set x_start [expr ${coord_x} - 2]
|
||||
set y_start [expr ${coord_y} - 2]
|
||||
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
|
||||
|
||||
set color ""
|
||||
catch { [set color "[vreadpixel ${position_x} ${position_y} rgb]"] }
|
||||
if {"$color" == ""} {
|
||||
puts "Warning : Pixel coordinates (${position_x}; ${position_y}) are out of view"
|
||||
incr j
|
||||
continue
|
||||
}
|
||||
set rd [lindex $color 0]
|
||||
set gr [lindex $color 1]
|
||||
set bl [lindex $color 2]
|
||||
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
|
||||
}
|
||||
|
||||
# auxiliary: check argument
|
||||
proc _check_arg {check_name check_result {get_value 0}} {
|
||||
upvar ${check_result} ${check_result}
|
||||
upvar arg arg
|
||||
upvar narg narg
|
||||
upvar args args
|
||||
if { $arg == ${check_name} } {
|
||||
if {${get_value}} {
|
||||
incr narg
|
||||
if { $narg < [llength $args] && ! [regexp {^-} [lindex $args $narg]] } {
|
||||
set ${check_result} "[lindex $args $narg]"
|
||||
} else {
|
||||
error "Option ${check_result} requires argument"
|
||||
}
|
||||
} else {
|
||||
set ${check_result} 1
|
||||
}
|
||||
return 1
|
||||
}
|
||||
return 0
|
||||
}
|
||||
|
||||
help checknbshapes {
|
||||
Compare number of sub-shapes in "shape" with given reference data
|
||||
|
||||
Use: checknbshapes shape [options...]
|
||||
Allowed options are:
|
||||
-vertex N
|
||||
-edge N
|
||||
-wire N
|
||||
-face N
|
||||
-shell N
|
||||
-solid N
|
||||
-compsolid N
|
||||
-compound N
|
||||
-shape N
|
||||
-t: compare the number of sub-shapes in "shape" counting
|
||||
the same sub-shapes with different location as different sub-shapes.
|
||||
-m msg: print "msg" in case of error
|
||||
-ref [nbshapes a]: compare the number of sub-shapes in "shape" and in "a".
|
||||
-vertex N, -edge N and other options are stil working.
|
||||
}
|
||||
proc checknbshapes {shape args} {
|
||||
puts "checknbshapes ${shape} ${args}"
|
||||
upvar ${shape} ${shape}
|
||||
|
||||
set nbVERTEX -1
|
||||
set nbEDGE -1
|
||||
set nbWIRE -1
|
||||
set nbFACE -1
|
||||
set nbSHELL -1
|
||||
set nbSOLID -1
|
||||
set nbCOMPSOLID -1
|
||||
set nbCOMPOUND -1
|
||||
set nbSHAPE -1
|
||||
|
||||
set message ""
|
||||
set count_locations 0
|
||||
set ref_info ""
|
||||
|
||||
for {set narg 0} {$narg < [llength $args]} {incr narg} {
|
||||
set arg [lindex $args $narg]
|
||||
if {[_check_arg "-vertex" nbVERTEX 1] ||
|
||||
[_check_arg "-edge" nbEDGE 1] ||
|
||||
[_check_arg "-wire" nbWIRE 1] ||
|
||||
[_check_arg "-face" nbFACE 1] ||
|
||||
[_check_arg "-shell" nbSHELL 1] ||
|
||||
[_check_arg "-solid" nbSOLID 1] ||
|
||||
[_check_arg "-compsolid" nbCOMPSOLID 1] ||
|
||||
[_check_arg "-compound" nbCOMPOUND 1] ||
|
||||
[_check_arg "-shape" nbSHAPE 1] ||
|
||||
[_check_arg "-t" count_locations] ||
|
||||
[_check_arg "-m" message 1] ||
|
||||
[_check_arg "-ref" ref_info 1]
|
||||
} {
|
||||
continue
|
||||
}
|
||||
# unsupported option
|
||||
if { [regexp {^-} $arg] } {
|
||||
error "Error: unsupported option \"$arg\""
|
||||
}
|
||||
error "Error: cannot interpret argument $narg ($arg)"
|
||||
}
|
||||
|
||||
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}
|
||||
|
||||
foreach Entity ${EntityList} {
|
||||
set expr_string "${Entity} +: +(\[-0-9.+eE\]+)"
|
||||
set to_compare {}
|
||||
# get number of elements from ${shape}
|
||||
if { [regexp "${expr_string}" ${nb_info} full nb_entity2] } {
|
||||
lappend to_compare ${nb_entity2}
|
||||
} else {
|
||||
error "Error : command \"nbshapes ${shape}\" gives an empty result"
|
||||
}
|
||||
# get number of elements from options -vertex -edge and so on
|
||||
set nb_entity1 [set nb${Entity}]
|
||||
if { ${nb_entity1} != -1 } {
|
||||
lappend to_compare ${nb_entity1}
|
||||
}
|
||||
# get number of elements from option -ref
|
||||
if { [regexp "${expr_string}" ${ref_info} full nb_entity_ref] } {
|
||||
lappend to_compare ${nb_entity_ref}
|
||||
}
|
||||
# skip comparing if no reference data was given
|
||||
if {[llength $to_compare] == 1} {
|
||||
continue
|
||||
}
|
||||
# compare all values, if they are equal, length of sorted list "to_compare"
|
||||
# (with key -unique) should be equal to 1
|
||||
set to_compare [lsort -dictionary -unique $to_compare]
|
||||
if { [llength $to_compare] != 1 } {
|
||||
puts "Error : ${message} is WRONG because number of ${Entity} entities in shape \"${shape}\" is ${nb_entity2}"
|
||||
} else {
|
||||
puts "OK : ${message} is GOOD because number of ${Entity} entities is equal to number of expected ${Entity} entities"
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Procedure to check equality of two reals with tolerance (relative and absolute)
|
||||
help checkreal {
|
||||
Compare value with expected
|
||||
Use: 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
|
||||
}
|
||||
|
||||
help checkfreebounds {
|
||||
Compare number of free edges with ref_value
|
||||
|
||||
Use: checkfreebounds shape ref_value [options...]
|
||||
Allowed options are:
|
||||
-tol N: used tolerance (default -0.01)
|
||||
-type N: used type, possible values are "closed" and "opened" (default "closed")
|
||||
}
|
||||
proc checkfreebounds {shape ref_value args} {
|
||||
puts "checkfreebounds ${shape} ${ref_value} ${args}"
|
||||
upvar ${shape} ${shape}
|
||||
|
||||
set tol -0.01
|
||||
set type "closed"
|
||||
|
||||
for {set narg 0} {$narg < [llength $args]} {incr narg} {
|
||||
set arg [lindex $args $narg]
|
||||
if {[_check_arg "-tol" tol 1] ||
|
||||
[_check_arg "-type" type 1]
|
||||
} {
|
||||
continue
|
||||
}
|
||||
# unsupported option
|
||||
if { [regexp {^-} $arg] } {
|
||||
error "Error: unsupported option \"$arg\""
|
||||
}
|
||||
error "Error: cannot interpret argument $narg ($arg)"
|
||||
}
|
||||
|
||||
if {"$type" != "closed" && "$type" != "opened"} {
|
||||
error "Error : wrong -type key \"${type}\""
|
||||
}
|
||||
|
||||
freebounds ${shape} ${tol}
|
||||
set free_edges [llength [explode ${shape}_[string range $type 0 0] e]]
|
||||
|
||||
if { ${ref_value} == -1 } {
|
||||
puts "Error : Number of free edges is UNSTABLE"
|
||||
return
|
||||
}
|
||||
|
||||
if { ${free_edges} != ${ref_value} } {
|
||||
puts "Error : Number of free edges is not equal to reference data"
|
||||
} else {
|
||||
puts "OK : Number of free edges is ${free_edges}"
|
||||
}
|
||||
}
|
||||
|
||||
help checkmaxtol {
|
||||
Compare max tolerance of shape with ref_value.
|
||||
Argument "source_shapes" is a list of used for sewing shapes.
|
||||
It can be empty to skip comparison of tolerance with source shapes.
|
||||
|
||||
Use: checkmaxtol shape ref_value [source_shapes={}] [options...]
|
||||
Allowed options are:
|
||||
-min_tol: minimum tolerance for comparison
|
||||
-multi_tol: tolerance multiplier
|
||||
}
|
||||
proc checkmaxtol {shape ref_value {source_shapes {}} args} {
|
||||
puts "checkmaxtol ${shape} ${ref_value} ${source_shapes} ${args}"
|
||||
upvar ${shape} ${shape}
|
||||
|
||||
set min_tol 0
|
||||
set tol_multiplier 0
|
||||
|
||||
for {set narg 0} {$narg < [llength $args]} {incr narg} {
|
||||
set arg [lindex $args $narg]
|
||||
if {[_check_arg "-min_tol" min_tol 1] ||
|
||||
[_check_arg "-multi_tol" tol_multiplier 1]
|
||||
} {
|
||||
continue
|
||||
}
|
||||
# unsupported option
|
||||
if { [regexp {^-} $arg] } {
|
||||
error "Error: unsupported option \"$arg\""
|
||||
}
|
||||
error "Error: cannot interpret argument $narg ($arg)"
|
||||
}
|
||||
|
||||
# get max tol of shape
|
||||
regexp {max tol = ([-0-9.+eE]+)} [tolmax ${shape}] full max_tol
|
||||
|
||||
checkreal "Max tolerance" $max_tol $ref_value 0.0001 0.01
|
||||
if {[llength $source_shapes]} {
|
||||
# find max tol of source shapes
|
||||
foreach source_shape $source_shapes {
|
||||
upvar ${source_shape} ${source_shape}
|
||||
regexp {max tol = ([-0-9.+eE]+)} [tolmax $source_shape] full _src_max_tol
|
||||
if { ${_src_max_tol} > ${min_tol} } {
|
||||
set min_tol ${_src_max_tol}
|
||||
}
|
||||
}
|
||||
if {${tol_multiplier}} {
|
||||
set min_tol [expr ${tol_multiplier} * ${_src_max_tol}]
|
||||
}
|
||||
# compare max tol of source shapes with max tol of sewing_result
|
||||
if { ${max_tol} > ${min_tol} } {
|
||||
puts "Error: tolerance of \"${shape}\" (${max_tol}) is greater than max tolerance of source shapes (${min_tol})"
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
help checkfaults {
|
||||
Compare faults number of given shapes.
|
||||
|
||||
Use: checkfaults shape source_shape [ref_value=0]
|
||||
}
|
||||
proc checkfaults {shape source_shape {ref_value 0}} {
|
||||
puts "checkfaults ${shape} ${source_shape} ${ref_value}"
|
||||
upvar $shape $shape
|
||||
upvar $source_shape $source_shape
|
||||
set cs_a [checkshape $source_shape]
|
||||
set nb_a 0
|
||||
if {[regexp {Faulty shapes in variables faulty_([0-9]*) to faulty_([0-9]*)} $cs_a full nb_a_begin nb_a_end]} {
|
||||
set nb_a [expr $nb_a_end - $nb_a_begin +1]
|
||||
}
|
||||
set cs_r [checkshape $shape]
|
||||
set nb_r 0
|
||||
if {[regexp {Faulty shapes in variables faulty_([0-9]*) to faulty_([0-9]*)} $cs_r full nb_r_begin nb_r_end]} {
|
||||
set nb_r [expr $nb_r_end - $nb_r_begin +1]
|
||||
}
|
||||
puts "Number of faults for the initial shape is $nb_a."
|
||||
puts "Number of faults for the resulting shape is $nb_r."
|
||||
|
||||
if { ${ref_value} == -1 } {
|
||||
puts "Error : Number of faults is UNSTABLE"
|
||||
return
|
||||
}
|
||||
|
||||
if { $nb_r > $nb_a } {
|
||||
puts "Error : Number of faults is $nb_r"
|
||||
}
|
||||
}
|
||||
@@ -36,7 +36,7 @@ if { [info exists env(DRAWHOME) ] } {
|
||||
|
||||
# load standard DRAW scripts
|
||||
if { [file isdirectory $dir] } {
|
||||
foreach script {StandardCommands.tcl Geometry.tcl StandardViews.tcl TestCommands.tcl} {
|
||||
foreach script {StandardCommands.tcl Geometry.tcl StandardViews.tcl TestCommands.tcl CheckCommands.tcl} {
|
||||
if [file exist [file join $dir $script]] {
|
||||
source [file join $dir $script]
|
||||
} else {
|
||||
|
||||
Reference in New Issue
Block a user