mirror of
https://git.dev.opencascade.org/repos/occt.git
synced 2025-08-29 14:00:49 +03:00
Update testing system for compatibly test case with master during prepare delivery
This commit is contained in:
bugmaster
@@ -170,15 +170,23 @@ proc _check_arg {check_name check_result {get_value 0}} {
|
||||
upvar narg narg
|
||||
upvar args args
|
||||
if { $arg == ${check_name} } {
|
||||
if {${get_value}} {
|
||||
if { ${get_value} == "?" } {
|
||||
set next_arg_index [expr $narg + 1]
|
||||
if { $next_arg_index < [llength $args] && ! [regexp {^-[^0-9]} [lindex $args $next_arg_index]] } {
|
||||
set ${check_result} "[lindex $args $next_arg_index]"
|
||||
set narg ${next_arg_index}
|
||||
} else {
|
||||
set ${check_result} "true"
|
||||
}
|
||||
} elseif {${get_value}} {
|
||||
incr narg
|
||||
if { $narg < [llength $args] && ! [regexp {^-} [lindex $args $narg]] } {
|
||||
if { $narg < [llength $args] && ! [regexp {^-[^0-9]} [lindex $args $narg]] } {
|
||||
set ${check_result} "[lindex $args $narg]"
|
||||
} else {
|
||||
error "Option ${check_result} requires argument"
|
||||
}
|
||||
} else {
|
||||
set ${check_result} 1
|
||||
set ${check_result} "true"
|
||||
}
|
||||
return 1
|
||||
}
|
||||
@@ -351,26 +359,36 @@ proc checkfreebounds {shape ref_value args} {
|
||||
}
|
||||
|
||||
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.
|
||||
Returns max tolerance of the shape and prints error message if specified
|
||||
criteria are not satisfied.
|
||||
|
||||
Use: checkmaxtol shape ref_value [source_shapes={}] [options...]
|
||||
Allowed options are:
|
||||
-min_tol: minimum tolerance for comparison
|
||||
-multi_tol: tolerance multiplier
|
||||
Use: checkmaxtol shape [options...]
|
||||
|
||||
Options specify criteria for checking the maximal tolerance value:
|
||||
-ref <value>: check it to be equal to reference value.
|
||||
-min_tol <value>: check it to be not greater than specified value.
|
||||
-source <list of shapes>: check it to be not greater than
|
||||
maximal tolerance of specified shape(s)
|
||||
-multi_tol <value>: additional multiplier for value specified by -min_tol
|
||||
or -shapes options.
|
||||
}
|
||||
proc checkmaxtol {shape ref_value {source_shapes {}} args} {
|
||||
puts "checkmaxtol ${shape} ${ref_value} ${source_shapes} ${args}"
|
||||
|
||||
proc checkmaxtol {shape args} {
|
||||
puts "checkmaxtol ${shape} ${args}"
|
||||
upvar ${shape} ${shape}
|
||||
|
||||
set ref_value ""
|
||||
set source_shapes {}
|
||||
set min_tol 0
|
||||
set tol_multiplier 0
|
||||
|
||||
# check arguments
|
||||
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]
|
||||
[_check_arg "-multi_tol" tol_multiplier 1] ||
|
||||
[_check_arg "-source" source_shapes 1] ||
|
||||
[_check_arg "-ref" ref_value 1]
|
||||
} {
|
||||
continue
|
||||
}
|
||||
@@ -382,26 +400,33 @@ proc checkmaxtol {shape ref_value {source_shapes {}} args} {
|
||||
}
|
||||
|
||||
# get max tol of shape
|
||||
regexp {max tol = ([-0-9.+eE]+)} [tolmax ${shape}] full max_tol
|
||||
set max_tol 0
|
||||
if {[regexp "Tolerance MAX=(\[-0-9.+eE\]+)" [tolerance ${shape}] full maxtol_temp]} {
|
||||
set max_tol ${maxtol_temp}
|
||||
} else {
|
||||
error "Error: cannot get tolerances of shape \"${shape}\""
|
||||
}
|
||||
|
||||
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})"
|
||||
# find max tol of source shapes
|
||||
foreach source_shape ${source_shapes} {
|
||||
upvar ${source_shape} ${source_shape}
|
||||
set _src_max_tol [checkmaxtol ${source_shape}]
|
||||
if { [expr ${_src_max_tol} > ${min_tol} ] } {
|
||||
set min_tol ${_src_max_tol}
|
||||
}
|
||||
}
|
||||
# apply -multi_tol option
|
||||
if {${tol_multiplier}} {
|
||||
set min_tol [expr ${tol_multiplier} * ${_src_max_tol}]
|
||||
}
|
||||
# compare max tol of source shapes with checking tolerance
|
||||
if { ${min_tol} && [expr ${max_tol} > ${min_tol}] } {
|
||||
puts "Error: tolerance of \"${shape}\" (${max_tol}) is greater than checking tolerance (${min_tol})"
|
||||
}
|
||||
if { ${ref_value} != "" } {
|
||||
checkreal "Max tolerance" ${max_tol} ${ref_value} 0.0001 0.01
|
||||
}
|
||||
return ${max_tol}
|
||||
}
|
||||
|
||||
help checkfaults {
|
||||
@@ -435,3 +460,632 @@ proc checkfaults {shape source_shape {ref_value 0}} {
|
||||
puts "Error : Number of faults is $nb_r"
|
||||
}
|
||||
}
|
||||
|
||||
# auxiliary: check all arguments
|
||||
proc _check_args { args {options {}} {command_name ""}} {
|
||||
# check arguments
|
||||
for {set narg 0} {${narg} < [llength ${args}]} {incr narg} {
|
||||
set arg [lindex ${args} ${narg}]
|
||||
set toContinue 0
|
||||
foreach option ${options} {
|
||||
set option_name [lindex ${option} 0]
|
||||
set variable_to_save_value [lindex ${option} 1]
|
||||
set get_value [lindex ${option} 2]
|
||||
set local_value ""
|
||||
if { [_check_arg ${option_name} local_value ${get_value}] } {
|
||||
upvar 1 ${variable_to_save_value} ${variable_to_save_value}
|
||||
set ${variable_to_save_value} ${local_value}
|
||||
set toContinue 1
|
||||
}
|
||||
}
|
||||
if {${toContinue}} { continue }
|
||||
# unsupported option
|
||||
if { [regexp {^-} ${arg}] } {
|
||||
error "Error: unsupported option \"${arg}\""
|
||||
}
|
||||
error "Error: cannot interpret argument ${narg} (${arg})"
|
||||
}
|
||||
foreach option ${options} {
|
||||
set option_name [lindex ${option} 0]
|
||||
set variable_to_save_value [lindex ${option} 1]
|
||||
set should_exist [lindex ${option} 3]
|
||||
if {![info exists ${variable_to_save_value}] && ${should_exist} == 1} {
|
||||
error "Error: wrong using of command '${command_name}', '${option_name}' option is required"
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
help checkprops {
|
||||
Procedure includes commands to compute length, area and volume of input shape.
|
||||
|
||||
Use: checkprops shapename [options...]
|
||||
Allowed options are:
|
||||
-l LENGTH: command lprops, computes the mass properties of all edges in the shape with a linear density of 1
|
||||
-s AREA: command sprops, computes the mass properties of all faces with a surface density of 1
|
||||
-v VOLUME: command vprops, computes the mass properties of all solids with a density of 1
|
||||
-eps EPSILON: the epsilon defines relative precision of computation
|
||||
-deps DEPSILON: the epsilon defines relative precision to compare corresponding values
|
||||
-equal SHAPE: compare area\volume\length of input shapes. Puts error if its are not equal
|
||||
-notequal SHAPE: compare area\volume\length of input shapes. Puts error if its are equal
|
||||
-skip: count shared shapes only once, skipping repeatitions
|
||||
Options -l, -s and -v are independent and can be used in any order. Tolerance epsilon is the same for all options.
|
||||
}
|
||||
|
||||
proc checkprops {shape args} {
|
||||
puts "checkprops ${shape} ${args}"
|
||||
upvar ${shape} ${shape}
|
||||
|
||||
if {![isdraw ${shape}] || [regexp "${shape} is a \n" [whatis ${shape}]]} {
|
||||
puts "Error: The command cannot be built"
|
||||
return
|
||||
}
|
||||
|
||||
set length -1
|
||||
set area -1
|
||||
set volume -1
|
||||
set epsilon 1.0e-4
|
||||
set compared_equal_shape -1
|
||||
set compared_notequal_shape -1
|
||||
set equal_check 0
|
||||
set skip 0
|
||||
set depsilon 1e-2
|
||||
|
||||
set options {{"-eps" epsilon 1}
|
||||
{"-equal" compared_equal_shape 1}
|
||||
{"-notequal" compared_notequal_shape 1}
|
||||
{"-skip" skip 0}
|
||||
{"-deps" depsilon 1}}
|
||||
|
||||
if { [regexp {\-[not]*equal} $args] } {
|
||||
lappend options {"-s" area 0}
|
||||
lappend options {"-l" length 0}
|
||||
lappend options {"-v" volume 0}
|
||||
set equal_check 1
|
||||
} else {
|
||||
lappend options {"-s" area 1}
|
||||
lappend options {"-l" length 1}
|
||||
lappend options {"-v" volume 1}
|
||||
}
|
||||
_check_args ${args} ${options} "checkprops"
|
||||
|
||||
if { ${length} != -1 || ${equal_check} == 1 } {
|
||||
lappend CommandNames {lprops}
|
||||
set equal_check 0
|
||||
}
|
||||
if { ${area} != -1 || ${equal_check} == 1 } {
|
||||
lappend CommandNames {sprops}
|
||||
set equal_check 0
|
||||
}
|
||||
if { ${volume} != -1 || ${equal_check} == 1 } {
|
||||
lappend CommandNames {vprops}
|
||||
set equal_check 0
|
||||
}
|
||||
|
||||
set skip_option ""
|
||||
if { $skip } {
|
||||
set skip_option "-skip"
|
||||
}
|
||||
|
||||
foreach CommandName ${CommandNames} {
|
||||
switch $CommandName {
|
||||
"lprops" { set mass ${length}; set prop "length" }
|
||||
"sprops" { set mass ${area}; set prop "area" }
|
||||
"vprops" { set mass ${volume}; set prop "volume" }
|
||||
}
|
||||
regexp {Mass +: +([-0-9.+eE]+)} [eval ${CommandName} ${shape} ${epsilon} $skip_option] full m
|
||||
|
||||
if { ${compared_equal_shape} != -1 } {
|
||||
upvar ${compared_equal_shape} ${compared_equal_shape}
|
||||
regexp {Mass +: +([-0-9.+eE]+)} [eval ${CommandName} ${compared_equal_shape} ${epsilon} $skip_option] full compared_m
|
||||
if { $compared_m != $m } {
|
||||
puts "Error: Shape ${compared_equal_shape} is not equal to shape ${shape}"
|
||||
}
|
||||
}
|
||||
|
||||
if { ${compared_notequal_shape} != -1 } {
|
||||
upvar ${compared_notequal_shape} ${compared_notequal_shape}
|
||||
regexp {Mass +: +([-0-9.+eE]+)} [eval ${CommandName} ${compared_notequal_shape} ${epsilon} $skip_option] full compared_m
|
||||
if { $compared_m == $m } {
|
||||
puts "Error: Shape ${compared_notequal_shape} is equal shape to ${shape}"
|
||||
}
|
||||
}
|
||||
|
||||
if { ${compared_equal_shape} == -1 && ${compared_notequal_shape} == -1 } {
|
||||
if { [string compare "$mass" "empty"] != 0 } {
|
||||
if { $m == 0 } {
|
||||
puts "Error : The command is not valid. The $prop is 0."
|
||||
}
|
||||
if { $mass > 0 } {
|
||||
puts "The expected $prop is $mass"
|
||||
}
|
||||
#check of change of area is < 1%
|
||||
if { ($mass != 0 && [expr 1.*abs($mass - $m)/$mass] > $depsilon) || ($mass == 0 && $m != 0) } {
|
||||
puts "Error : The $prop of result shape is $m"
|
||||
}
|
||||
} else {
|
||||
if { $m != 0 } {
|
||||
puts "Error : The command is not valid. The $prop is $m"
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
help checkdump {
|
||||
Procedure includes command to parse output dump and compare it with reference values.
|
||||
|
||||
Use: checkdump shapename [options...]
|
||||
Allowed options are:
|
||||
-name NAME: list of parsing parameters (e.g. Center, Axis, etc)
|
||||
-ref VALUE: list of reference values for each parameter in NAME
|
||||
-eps EPSILON: the epsilon defines relative precision of computation
|
||||
}
|
||||
|
||||
proc checkdump {shape args} {
|
||||
puts "checkdump ${shape} ${args}"
|
||||
upvar ${shape} ${shape}
|
||||
|
||||
set ddump -1
|
||||
set epsilon -1
|
||||
set options {{"-name" params 1}
|
||||
{"-ref" ref 1}
|
||||
{"-eps" epsilon 1}
|
||||
{"-dump" ddump 1}}
|
||||
|
||||
if { ${ddump} == -1 } {
|
||||
set ddump [dump ${shape}]
|
||||
}
|
||||
_check_args ${args} ${options} "checkdump"
|
||||
|
||||
set index 0
|
||||
foreach param ${params} {
|
||||
set pattern "${param}\\s*:\\s*"
|
||||
set number_pattern "(\[-0-9.+eE\]+)\\s*"
|
||||
set ref_values ""
|
||||
set local_ref ${ref}
|
||||
if { [llength ${params}] > 1 } {
|
||||
set local_ref [lindex ${ref} ${index}]
|
||||
}
|
||||
foreach item ${local_ref} {
|
||||
if { ![regexp "$pattern$number_pattern" $ddump full res] } {
|
||||
puts "Error: cheked parameter ${param} is not listed in dump"
|
||||
break
|
||||
}
|
||||
lappend ref_values $res
|
||||
set pattern "${pattern}${res},\\s*"
|
||||
## without precision
|
||||
if { ${epsilon} == -1 } {
|
||||
if { ${item} != ${res} } {
|
||||
puts "Error: parameter ${param} - current value (${res}) is not equal to reference value (${item})"
|
||||
} else {
|
||||
puts "OK: parameter ${param} - current value (${res}) is equal to reference value (${item})"
|
||||
}
|
||||
## with precision
|
||||
} else {
|
||||
set precision 0.0000001
|
||||
if { ( abs($res) > $precision ) || ( abs($item) > $precision ) } {
|
||||
if { ($item != 0 && [expr 1.*abs($item - $res)/$item] > $epsilon) || ($item == 0 && $res != 0) } {
|
||||
puts "Error: The $param of the resulting shape is $res and the expected $param is $item"
|
||||
} else {
|
||||
puts "OK: parameter ${param} - current value (${res}) is equal to reference value (${item})"
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
incr index
|
||||
}
|
||||
}
|
||||
|
||||
help checklength {
|
||||
Procedure includes commands to compute length of input curve.
|
||||
|
||||
Use: checklength curvename [options...]
|
||||
Allowed options are:
|
||||
-l LENGTH: command length, computes the length of input curve with precision of computation
|
||||
-eps EPSILON: the epsilon defines relative precision of computation
|
||||
-equal CURVE: compare length of input curves. Puts error if its are not equal
|
||||
-notequal CURVE: compare length of input curves. Puts error if its are equal
|
||||
}
|
||||
|
||||
proc checklength {shape args} {
|
||||
puts "checklength ${shape} ${args}"
|
||||
upvar ${shape} ${shape}
|
||||
|
||||
if {![isdraw ${shape}] || [regexp "${shape} is a \n" [whatis ${shape}]]} {
|
||||
puts "Error: The command cannot be built"
|
||||
return
|
||||
}
|
||||
|
||||
set length -1
|
||||
set epsilon 1.0e-4
|
||||
set compared_equal_shape -1
|
||||
set compared_notequal_shape -1
|
||||
set equal_check 0
|
||||
|
||||
set options {{"-eps" epsilon 1}
|
||||
{"-equal" compared_equal_shape 1}
|
||||
{"-notequal" compared_notequal_shape 1}}
|
||||
|
||||
if { [regexp {\-[not]*equal} $args] } {
|
||||
lappend options {"-l" length 0}
|
||||
set equal_check 1
|
||||
} else {
|
||||
lappend options {"-l" length 1}
|
||||
}
|
||||
_check_args ${args} ${options} "checkprops"
|
||||
|
||||
if { ${length} != -1 || ${equal_check} == 1 } {
|
||||
set CommandName length
|
||||
set mass $length
|
||||
set prop "length"
|
||||
set equal_check 0
|
||||
}
|
||||
|
||||
regexp "The +length+ ${shape} +is +(\[-0-9.+eE\]+)" [${CommandName} ${shape} ${epsilon}] full m
|
||||
|
||||
if { ${compared_equal_shape} != -1 } {
|
||||
upvar ${compared_equal_shape} ${compared_equal_shape}
|
||||
regexp "The +length+ ${compared_equal_shape} +is +(\[-0-9.+eE\]+)" [${CommandName} ${compared_equal_shape} ${epsilon}] full compared_m
|
||||
if { $compared_m != $m } {
|
||||
puts "Error: length of shape ${compared_equal_shape} is not equal to shape ${shape}"
|
||||
}
|
||||
}
|
||||
|
||||
if { ${compared_notequal_shape} != -1 } {
|
||||
upvar ${compared_notequal_shape} ${compared_notequal_shape}
|
||||
regexp "The +length+ ${compared_notequal_shape} +is +(\[-0-9.+eE\]+)" [${CommandName} ${compared_notequal_shape} ${epsilon}] full compared_m
|
||||
if { $compared_m == $m } {
|
||||
puts "Error: length of shape ${compared_notequal_shape} is equal shape to ${shape}"
|
||||
}
|
||||
}
|
||||
|
||||
if { ${compared_equal_shape} == -1 && ${compared_notequal_shape} == -1 } {
|
||||
if { [string compare "$mass" "empty"] != 0 } {
|
||||
if { $m == 0 } {
|
||||
puts "Error : The command is not valid. The $prop is 0."
|
||||
}
|
||||
if { $mass > 0 } {
|
||||
puts "The expected $prop is $mass"
|
||||
}
|
||||
#check of change of area is < 1%
|
||||
if { ($mass != 0 && [expr 1.*abs($mass - $m)/$mass] > 0.01) || ($mass == 0 && $m != 0) } {
|
||||
puts "Error : The $prop of result shape is $m"
|
||||
}
|
||||
} else {
|
||||
if { $m != 0 } {
|
||||
puts "Error : The command is not valid. The $prop is $m"
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
help checkview {
|
||||
Display shape in selected viewer.
|
||||
|
||||
Use: checkview [options...]
|
||||
Allowed options are:
|
||||
-display shapename: display shape with name 'shapename'
|
||||
-3d: display shape in 3d viewer
|
||||
-2d [ v2d / smallview ]: display shape in 2d viewer (default viewer is a 'smallview')
|
||||
-vdispmode N: it is possible to set vdispmode for 3d viewer (default value is 1)
|
||||
-screenshot: procedure will try to make screenshot of already created viewer
|
||||
-path <path>: location of saved screenshot of viewer
|
||||
|
||||
Procedure can check some property of shape (length, area or volume) and compare it with some value N:
|
||||
-l [N]
|
||||
-s [N]
|
||||
-v [N]
|
||||
If current property is equal to value N, shape is marked as valid in procedure.
|
||||
If value N is not given procedure will mark shape as valid if current property is non-zero.
|
||||
-with {a b c}: display shapes 'a' 'b' 'c' together with 'shape' (if shape is valid)
|
||||
-otherwise {d e f}: display shapes 'd' 'e' 'f' instead of 'shape' (if shape is NOT valid)
|
||||
Note that one of two options -2d/-3d is required.
|
||||
}
|
||||
|
||||
proc checkview {args} {
|
||||
puts "checkview ${args}"
|
||||
|
||||
set 3dviewer 0
|
||||
set 2dviewer false
|
||||
set shape ""
|
||||
set PathToSave ""
|
||||
set dispmode 1
|
||||
set isScreenshot 0
|
||||
set check_length false
|
||||
set check_area false
|
||||
set check_volume false
|
||||
set otherwise {}
|
||||
set with {}
|
||||
|
||||
set options {{"-3d" 3dviewer 0}
|
||||
{"-2d" 2dviewer ?}
|
||||
{"-display" shape 1}
|
||||
{"-path" PathToSave 1}
|
||||
{"-vdispmode" dispmode 1}
|
||||
{"-screenshot" isScreenshot 0}
|
||||
{"-otherwise" otherwise 1}
|
||||
{"-with" with 1}
|
||||
{"-l" check_length ?}
|
||||
{"-s" check_area ?}
|
||||
{"-v" check_volume ?}}
|
||||
|
||||
# check arguments
|
||||
_check_args ${args} ${options} "checkview"
|
||||
|
||||
if { ${PathToSave} == "" } {
|
||||
set PathToSave "./photo.png"
|
||||
}
|
||||
|
||||
if { ${3dviewer} == 0 && ${2dviewer} == false } {
|
||||
error "Error: wrong using of command 'checkview', please use -2d or -3d option"
|
||||
}
|
||||
|
||||
if { ${isScreenshot} } {
|
||||
if { ${3dviewer} } {
|
||||
vdump ${PathToSave}
|
||||
} else {
|
||||
xwd ${PathToSave}
|
||||
}
|
||||
return
|
||||
}
|
||||
|
||||
set mass 0
|
||||
set isBAD 0
|
||||
upvar ${shape} ${shape}
|
||||
if {[isdraw ${shape}]} {
|
||||
# check area
|
||||
if { [string is boolean ${check_area}] } {
|
||||
if { ${check_area} } {
|
||||
regexp {Mass +: +([-0-9.+eE]+)} [sprops ${shape}] full mass
|
||||
}
|
||||
} else {
|
||||
set mass ${check_area}
|
||||
}
|
||||
# check length
|
||||
if { [string is boolean ${check_length}] } {
|
||||
if { ${check_length} } {
|
||||
regexp {Mass +: +([-0-9.+eE]+)} [lprops ${shape}] full mass
|
||||
}
|
||||
} else {
|
||||
set mass ${check_length}
|
||||
}
|
||||
# check volume
|
||||
if { [string is boolean ${check_volume}] } {
|
||||
if { ${check_volume} } {
|
||||
regexp {Mass +: +([-0-9.+eE]+)} [vprops ${shape}] full mass
|
||||
}
|
||||
} else {
|
||||
set mass ${check_volume}
|
||||
}
|
||||
} else {
|
||||
set isBAD 1
|
||||
}
|
||||
if { ${3dviewer} } {
|
||||
vinit
|
||||
vclear
|
||||
} elseif { ([string is boolean ${2dviewer}] && ${2dviewer}) || ${2dviewer} == "smallview"} {
|
||||
smallview
|
||||
clear
|
||||
} elseif { ${2dviewer} == "v2d"} {
|
||||
v2d
|
||||
2dclear
|
||||
}
|
||||
if {[isdraw ${shape}]} {
|
||||
if { ( ${check_area} == false && ${check_length} == false && ${check_volume} == false ) || ( ${mass} != 0 ) } {
|
||||
foreach s ${with} {
|
||||
upvar ${s} ${s}
|
||||
}
|
||||
lappend with ${shape}
|
||||
if { ${3dviewer} } {
|
||||
vdisplay {*}${with}
|
||||
} else {
|
||||
donly {*}${with}
|
||||
}
|
||||
} else {
|
||||
set isBAD 1
|
||||
}
|
||||
} else {
|
||||
set isBAD 1
|
||||
}
|
||||
|
||||
if { ${isBAD} && [llength ${otherwise}] } {
|
||||
foreach s ${otherwise} {
|
||||
upvar ${s} ${s}
|
||||
}
|
||||
if { ${3dviewer} } {
|
||||
vdisplay {*}${otherwise}
|
||||
} else {
|
||||
donly {*}${otherwise}
|
||||
}
|
||||
}
|
||||
|
||||
if { ${3dviewer} } {
|
||||
vsetdispmode ${dispmode}
|
||||
vfit
|
||||
vdump ${PathToSave}
|
||||
} else {
|
||||
if { ([string is boolean ${2dviewer}] && ${2dviewer}) || ${2dviewer} == "smallview"} {
|
||||
fit
|
||||
} elseif { ${2dviewer} == "v2d"} {
|
||||
2dfit
|
||||
}
|
||||
xwd ${PathToSave}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
help checktrinfo {
|
||||
Compare maximum deflection, number of nodes and triangles in "shape" mesh with given reference data
|
||||
|
||||
Use: checktrinfo shapename [options...]
|
||||
Allowed options are:
|
||||
-tri [N]: compare current number of triangles in "shapename" mesh with given reference data.
|
||||
If reference value N is not given and current number of triangles is equal to 0
|
||||
procedure checktrinfo will print an error.
|
||||
-nod [N]: compare current number of nodes in "shapename" mesh with given reference data.
|
||||
If reference value N is not givenand current number of nodes is equal to 0
|
||||
procedure checktrinfo will print an error.
|
||||
-defl [N]: compare current value of maximum deflection in "shapename" mesh with given reference data
|
||||
If reference value N is not given and current maximum deflection is equal to 0
|
||||
procedure checktrinfo will print an error.
|
||||
-max_defl N: compare current value of maximum deflection in "shapename" mesh with max possible value
|
||||
-tol_abs_tri N: absolute tolerance for comparison of number of triangles (default value 0)
|
||||
-tol_rel_tri N: relative tolerance for comparison of number of triangles (default value 0)
|
||||
-tol_abs_nod N: absolute tolerance for comparison of number of nodes (default value 0)
|
||||
-tol_rel_nod N: relative tolerance for comparison of number of nodes (default value 0)
|
||||
-tol_abs_defl N: absolute tolerance for deflection comparison (default value 0)
|
||||
-tol_rel_defl N: relative tolerance for deflection comparison (default value 0)
|
||||
-ref [trinfo a]: compare deflection, number of triangles and nodes in "shapename" and in "a"
|
||||
}
|
||||
proc checktrinfo {shape args} {
|
||||
puts "checktrinfo ${shape} ${args}"
|
||||
upvar ${shape} ${shape}
|
||||
|
||||
if {![isdraw ${shape}] || [regexp "${shape} is a \n" [whatis ${shape}]]} {
|
||||
puts "Error: The command cannot be built"
|
||||
return
|
||||
}
|
||||
|
||||
set ref_nb_triangles false
|
||||
set ref_nb_nodes false
|
||||
set ref_deflection false
|
||||
set tol_abs_defl 0
|
||||
set tol_rel_defl 0
|
||||
set tol_abs_tri 0
|
||||
set tol_rel_tri 0
|
||||
set tol_abs_nod 0
|
||||
set tol_rel_nod 0
|
||||
set max_defl -1
|
||||
set ref_info ""
|
||||
|
||||
set options {{"-tri" ref_nb_triangles ?}
|
||||
{"-nod" ref_nb_nodes ?}
|
||||
{"-defl" ref_deflection ?}
|
||||
{"-tol_abs_defl" tol_abs_defl 1}
|
||||
{"-tol_rel_defl" tol_rel_defl 1}
|
||||
{"-tol_abs_tri" tol_abs_tri 1}
|
||||
{"-tol_rel_tri" tol_rel_tri 1}
|
||||
{"-tol_abs_nod" tol_abs_nod 1}
|
||||
{"-tol_rel_nod" tol_rel_nod 1}
|
||||
{"-max_defl" max_defl 1}
|
||||
{"-ref" ref_info 1}}
|
||||
|
||||
_check_args ${args} ${options} "checktrinfo"
|
||||
|
||||
# get current number of triangles and nodes, value of max deflection
|
||||
set tri_info [trinfo ${shape}]
|
||||
set triinfo_pattern "(\[0-9\]+) +triangles.*\[^0-9]\(\[0-9\]+) +nodes.*deflection +(\[-0-9.+eE\]+)"
|
||||
if {![regexp "${triinfo_pattern}" ${tri_info} dump cur_nb_triangles cur_nb_nodes cur_deflection]} {
|
||||
puts "Error: command trinfo prints empty info"
|
||||
}
|
||||
|
||||
# get reference values from -ref option
|
||||
if { "${ref_info}" != ""} {
|
||||
if {![regexp "${triinfo_pattern}" ${ref_info} dump ref_nb_triangles ref_nb_nodes ref_deflection]} {
|
||||
puts "Error: reference information gived by -ref option is wrong"
|
||||
}
|
||||
}
|
||||
|
||||
# check number of triangles
|
||||
if { [string is boolean ${ref_nb_triangles}] } {
|
||||
if { ${cur_nb_triangles} <= 0 && ${ref_nb_triangles} } {
|
||||
puts "Error: Number of triangles is equal to 0"
|
||||
}
|
||||
} else {
|
||||
if {[regexp {!([-0-9.+eE]+)} $ref_nb_triangles full ref_nb_triangles_value]} {
|
||||
if {${ref_nb_triangles_value} == ${cur_nb_triangles} } {
|
||||
puts "Error: Number of triangles is equal to ${ref_nb_triangles_value} but it should not"
|
||||
}
|
||||
} else {
|
||||
checkreal "Number of triangles" ${cur_nb_triangles} ${ref_nb_triangles} ${tol_abs_tri} ${tol_rel_tri}
|
||||
}
|
||||
}
|
||||
|
||||
# check number of nodes
|
||||
if { [string is boolean ${ref_nb_nodes}] } {
|
||||
if { ${cur_nb_nodes} <= 0 && ${ref_nb_nodes} } {
|
||||
puts "Error: Number of nodes is equal to 0"
|
||||
}
|
||||
} else {
|
||||
if {[regexp {!([-0-9.+eE]+)} $ref_nb_nodes full ref_nb_nodes_value]} {
|
||||
if {${ref_nb_nodes_value} == ${cur_nb_nodes} } {
|
||||
puts "Error: Number of nodes is equal to ${ref_nb_nodes_value} but it should not"
|
||||
}
|
||||
} else {
|
||||
checkreal "Number of nodes" ${cur_nb_nodes} ${ref_nb_nodes} ${tol_abs_nod} ${tol_rel_nod}
|
||||
}
|
||||
}
|
||||
|
||||
# check deflection
|
||||
if { [string is boolean ${ref_deflection}] } {
|
||||
if { ${cur_deflection} <= 0 && ${ref_deflection} } {
|
||||
puts "Error: Maximal deflection is equal to 0"
|
||||
}
|
||||
} else {
|
||||
checkreal "Maximal deflection" ${cur_deflection} ${ref_deflection} ${tol_abs_defl} ${tol_rel_defl}
|
||||
}
|
||||
|
||||
if { ${max_defl} != -1 && ${cur_deflection} > ${max_defl} } {
|
||||
puts "Error: Maximal deflection is too big"
|
||||
}
|
||||
}
|
||||
|
||||
help checkplatform {
|
||||
Return name of current platform if no options are given.
|
||||
|
||||
Use: checkplatform [options...]
|
||||
Allowed options are:
|
||||
-windows : return 1 if current platform is 'Windows', overwise return 0
|
||||
-linux : return 1 if current platform is 'Linux', overwise return 0
|
||||
-osx : return 1 if current platform is 'MacOS X', overwise return 0
|
||||
|
||||
Only one option can be used at once.
|
||||
If no option is given, procedure will return the name of current platform.
|
||||
}
|
||||
proc checkplatform {args} {
|
||||
set check_for_windows false
|
||||
set check_for_linux false
|
||||
set check_for_macosx false
|
||||
|
||||
set options {{"-windows" check_for_windows 0}
|
||||
{"-linux" check_for_linux 0}
|
||||
{"-osx" check_for_macosx 0}}
|
||||
|
||||
_check_args ${args} ${options} "checkplatform"
|
||||
|
||||
if { [regexp "indows" $::tcl_platform(os)] } {
|
||||
set current_platform Windows
|
||||
} elseif { $::tcl_platform(os) == "Linux" } {
|
||||
set current_platform Linux
|
||||
} elseif { $::tcl_platform(os) == "Darwin" } {
|
||||
set current_platform MacOS
|
||||
}
|
||||
|
||||
# no args are given
|
||||
if { !${check_for_windows} && !${check_for_linux} && !${check_for_macosx}} {
|
||||
return ${current_platform}
|
||||
}
|
||||
|
||||
# check usage of proc checkplatform
|
||||
if { [expr [string is true ${check_for_windows}] + [string is true ${check_for_linux}] + [string is true ${check_for_macosx}] ] > 1} {
|
||||
error "Error: wrong usage of command checkplatform, only single option can be used at once"
|
||||
}
|
||||
|
||||
# checking for Windows platform
|
||||
if { ${check_for_windows} && ${current_platform} == "Windows" } {
|
||||
return 1
|
||||
}
|
||||
|
||||
# checking for Mac OS X platforms
|
||||
if { ${check_for_linux} && ${current_platform} == "Linux" } {
|
||||
return 1
|
||||
}
|
||||
|
||||
# checking for Mac OS X platforms
|
||||
if { ${check_for_macosx} && ${current_platform} == "MacOS" } {
|
||||
return 1
|
||||
}
|
||||
|
||||
# current platform is not equal to given as argument platform, return false
|
||||
return 0
|
||||
}
|
||||
|
||||
@@ -95,6 +95,7 @@ help help {help pattern, or help command string group, to set help} {DRAW Genera
|
||||
# the getsourcefile command in TCL
|
||||
#################################################
|
||||
|
||||
help getsourcefile {getsourcefile, or getsourcefile command } {DRAW General Commands}
|
||||
|
||||
proc getsourcefile {{command ""}} {
|
||||
|
||||
@@ -136,8 +137,6 @@ proc getsourcefile {{command ""}} {
|
||||
return [join $out "\n"]
|
||||
}
|
||||
|
||||
help getsourcefile {getsourcefile, or getsourcefile command } {DRAW General Commands}
|
||||
|
||||
#################################################
|
||||
# whatis
|
||||
#################################################
|
||||
@@ -147,6 +146,8 @@ help getsourcefile {getsourcefile, or getsourcefile command } {DRAW General Comm
|
||||
# puts -nonewline $aVarName; puts -nonewline " is a "; puts [dtyp ${aVarName}]
|
||||
#}
|
||||
|
||||
help whatis "whatis object1 object2 ..."
|
||||
|
||||
proc whatis args {
|
||||
set __out_string ""
|
||||
foreach i $args {
|
||||
@@ -159,8 +160,6 @@ proc whatis args {
|
||||
return ${__out_string}
|
||||
}
|
||||
|
||||
help whatis "whatis object1 object2 ..."
|
||||
|
||||
#################################################
|
||||
# library, lsource
|
||||
#################################################
|
||||
@@ -195,6 +194,8 @@ proc isgdraw {var} {
|
||||
return [isdraw $var]
|
||||
}
|
||||
|
||||
help directory {directory [pattern], list draw variables} {DRAW Variables management}
|
||||
|
||||
proc directory {{joker *}} {
|
||||
set res ""
|
||||
foreach var [info globals $joker] {
|
||||
@@ -203,8 +204,6 @@ proc directory {{joker *}} {
|
||||
return $res
|
||||
}
|
||||
|
||||
help directory {directory [pattern], list draw variables} {DRAW Variables management}
|
||||
|
||||
proc lsd {} { exec ls [datadir] }
|
||||
|
||||
proc dall {} {
|
||||
@@ -259,6 +258,8 @@ proc do {var start end args} {
|
||||
|
||||
set Draw_DataDir "."
|
||||
|
||||
help datadir {datadir [directory]} "DRAW Variables management"
|
||||
|
||||
proc datadir {{dir ""}} {
|
||||
global Draw_DataDir
|
||||
if {$dir != ""} {
|
||||
@@ -271,7 +272,7 @@ proc datadir {{dir ""}} {
|
||||
return $Draw_DataDir
|
||||
}
|
||||
|
||||
help datadir {datadir [directory]} "DRAW Variables management"
|
||||
help save {save variable [filename]} "DRAW Variables management"
|
||||
|
||||
proc save {name {file ""}} {
|
||||
if {$file == ""} {set file $name}
|
||||
@@ -282,7 +283,7 @@ proc save {name {file ""}} {
|
||||
return [file join $Draw_DataDir $file]
|
||||
}
|
||||
|
||||
help save {save variable [filename]} "DRAW Variables management"
|
||||
help restore {restore filename [variablename]} "DRAW Variables management"
|
||||
|
||||
proc restore {file {name ""}} {
|
||||
if {$name == ""} {
|
||||
@@ -295,8 +296,6 @@ proc restore {file {name ""}} {
|
||||
return $name
|
||||
}
|
||||
|
||||
help restore {restore filename [variablename]} "DRAW Variables management"
|
||||
|
||||
#################################################
|
||||
# misc...
|
||||
#################################################
|
||||
@@ -311,6 +310,7 @@ proc ppcurve {a} {
|
||||
# display and donly with jokers
|
||||
#################################################
|
||||
|
||||
help disp {display variables matched by glob pattern} "DRAW Variables management"
|
||||
|
||||
proc disp { args } {
|
||||
set res ""
|
||||
@@ -331,25 +331,7 @@ proc disp { args } {
|
||||
return $res
|
||||
}
|
||||
|
||||
|
||||
proc donl { args } {
|
||||
set res ""
|
||||
foreach joker $args {
|
||||
if { $joker == "." } {
|
||||
dtyp .
|
||||
set joker [lastrep id x y b]
|
||||
}
|
||||
foreach var [info globals $joker] {
|
||||
if { $var == "." } {
|
||||
dtyp .
|
||||
set var [lastrep id x y b]
|
||||
}
|
||||
if [isgdraw $var] {lappend res $var}
|
||||
}
|
||||
}
|
||||
uplevel #0 eval donly $res
|
||||
return $res
|
||||
}
|
||||
help don {display only variables matched by glob pattern} "DRAW Variables management"
|
||||
|
||||
proc don { args } {
|
||||
set res ""
|
||||
@@ -369,3 +351,92 @@ proc don { args } {
|
||||
uplevel #0 eval donly $res
|
||||
return $res
|
||||
}
|
||||
|
||||
help del {unset (remove) variables matched by glob pattern} "DRAW Variables management"
|
||||
|
||||
proc del args {
|
||||
set res ""
|
||||
foreach joker [eval concat $args] {
|
||||
if { $joker == "." } {
|
||||
dtyp .
|
||||
set joker [lastrep id x y b]
|
||||
}
|
||||
foreach var [directory $joker] {
|
||||
global $var
|
||||
if ![isprot $var] {
|
||||
lappend res $var; unset $var
|
||||
}
|
||||
}
|
||||
}
|
||||
return $res
|
||||
}
|
||||
|
||||
help era {erase variables matched by glob pattern} "DRAW Variables management"
|
||||
|
||||
proc era args {
|
||||
set res ""
|
||||
foreach joker [eval concat $args] {
|
||||
if { $joker == "." } {
|
||||
dtyp .
|
||||
set joker [lastrep id x y b]
|
||||
}
|
||||
eval lappend res [directory $joker]
|
||||
}
|
||||
if [llength $res] {
|
||||
uplevel \#0 eval erase $res
|
||||
}
|
||||
}
|
||||
|
||||
# The following commands (definitions are surrounded by if) are
|
||||
# available in extended Tcl (Tclx).
|
||||
# These procedures are added just to make full-working simulations of them.
|
||||
|
||||
if {[info commands lvarpop] == ""} {
|
||||
proc lvarpop args {
|
||||
upvar [lindex $args 0] lvar
|
||||
set index 0
|
||||
set len [llength $lvar]
|
||||
if {[llength $args] > 1} {
|
||||
set ind [lindex $args 1]
|
||||
if [regexp "^end" $ind] {
|
||||
set index [expr $len-1]
|
||||
} elseif [regexp "^len" $ind] {
|
||||
set index $len
|
||||
} else {set index $ind}
|
||||
}
|
||||
set el [lindex $lvar $index]
|
||||
set newlvar {}
|
||||
for {set i 0} {$i < $index} {incr i} {
|
||||
lappend newlvar [lindex $lvar $i]
|
||||
}
|
||||
if {[llength $args] > 2} {
|
||||
lappend newlvar [lindex $args 2]
|
||||
}
|
||||
for {set i [expr $index+1]} {$i < $len} {incr i} {
|
||||
lappend newlvar [lindex $lvar $i]
|
||||
}
|
||||
set lvar $newlvar
|
||||
return $el
|
||||
}
|
||||
}
|
||||
|
||||
if {[info commands lmatch] == ""} {
|
||||
proc lmatch args {
|
||||
set mode [switch -- [lindex $args 0] {
|
||||
-exact {format 0}
|
||||
-glob {format 1}
|
||||
-regexp {format 2}}]
|
||||
if {$mode == ""} {set mode 1} else {lvarpop args}
|
||||
if {[llength $args] < 2} {puts "usage: lmatch ?mode? list pattern";return}
|
||||
set list [lindex $args 0]
|
||||
set pattern [lindex $args 1]
|
||||
set res {}
|
||||
foreach a $list {
|
||||
if [switch $mode {
|
||||
0 {expr [string compare $a $pattern] == 0}
|
||||
1 {string match $pattern $a}
|
||||
2 {regexp $pattern $a}}] {lappend res $a}
|
||||
}
|
||||
return $res
|
||||
}
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user