tests/caf/nam/begin

   1 # File : begin
   2 if { [array get Draw_Groups "TOPOLOGY Check commands"] == "" } {
   3     pload TOPTEST
   4     pload VISUALIZATION
   5 }
   6 pload XDE
   7 pload QAcommands
   8
   9 if { [info exists imagedir] == 0 } {
  10    set imagedir .
  11 }
  12 if { [info exists test_image] == 0 } {
  13    set test_image photo
  14 }
  15
  16 set scriptdir [file dirname [info script]]
  17
  18 set mistake 0
  19
  20 #################### procedure GetDigit returns digit (cutted) from string ####################
  21 proc GetDigit {s} {
  22   set res ""
  23   for {set a 0} {$a < [string length $s]} {incr a} {
  24     if {[string index $s $a]>="0" && [string index $s $a]<="9"} {
  25         set res [set res][string index $s $a]
  26     } else {
  27       if {[string index $s $a]=="e" || [string index $s $a]=="-"} {
  28         set res [set res][string index $s $a]
  29       } else {return $res}
  30     } else {return $res}
  31   }
  32   return $res
  33 }
  34
  35 #################### procedure ShapeCenter returns (three coords string) center of given shape
  36 proc ShapeCenter {s} {
  37 puts $s
  38   global $s
  39   return [CenterOfShape $s]
  40 #  set ss [explode $s V]
  41 #  if {[llength $ss] == 0} {set ss $s}
  42 #  set x 0
  43 #  set y 0
  44 #  set z 0
  45 #  for {set a 0} {[lindex $ss $a] != ""} {incr a} {
  46 #    set dmp [dump [lindex $ss $a]]
  47 #    set fromindex [lsearch $dmp Elementary]
  48 #    if {$fromindex != -1} {
  49 #      set x [expr $x+[GetDigit [lindex $dmp [expr $fromindex+6]]]]
  50 #      set y [expr $y+[GetDigit [lindex $dmp [expr $fromindex+12]]]]
  51 #      set z [expr $z+[GetDigit [lindex $dmp [expr $fromindex+18]]]]
  52 #    }
  53 #    set fromindex [lsearch $dmp "3D"]
  54 #    set x [expr $x+[GetDigit [lindex $dmp [expr $fromindex+2]]]]
  55 #    set y [expr $y+[GetDigit [lindex $dmp [expr $fromindex+3]]]]
  56 #    set z [expr $z+[GetDigit [lindex $dmp [expr $fromindex+4]]]]
  57 #  }
  58 #  set x [expr $x/[llength $ss]]
  59 #  set y [expr $y/[llength $ss]]
  60 #  set z [expr $z/[llength $ss]]
  61 #  return "$x $y $z"
  62 }
  63
  64 #################### procedure IsSame returns true, if given shapes has same TShapes ####################
  65 proc IsSame {s1 s2} {
  66   global $s1 $s2
  67 puts "$s1 $s2"
  68   if {[IsSameShapes $s1 $s2] == 1} {return 1}
  69   return 0
  70 #
  71 #  set d1 [dump $s1]
  72 #  set d2 [dump $s1]
  73 #  if {[llength $d1]<10 || [llength $d2]<10} {
  74 #       return 0
  75 #  }
  76 #
  77 #  if {[lindex [dump $s1] 28] == [lindex [dump $s2] 28]} {
  78 #    if {[lindex [dump $s1] 29] == [lindex [dump $s2] 29]} {return 1}
  79 #  }
  80 #  return 0
  81 }
  82
  83 #################### procedure NextLabel set lab as next label of lab at this level ####################
  84 proc NextLabel {lab} {
  85   upvar 1 $lab l
  86   set i [string last ":" "[set l]"]
  87   if {$i == -1} {set l [expr [set l]+1]} else {
  88     set l [string range [set l] 0 $i][expr 1+[string range [set l] [expr $i+1] [string length [set l]]]]
  89   }
  90 }
  91
  92 #################### checking the naming at myLab label ( tests at myNameLab label ) ####################
  93 #################### show errors, increments working labels                          ####################
  94 proc Checking {Name} {
  95   global D IsDone TestError
  96   upvar 1 myLab l1 myNameLab l2
  97
  98   set bad ""
  99   if {[catch {set bad [CheckNaming D $l2 1 Label $l1 1 1 1]}]} {
 100         set IsDone 0
 101         set TestError "$TestError # $Name naming failed at label $l2 with exception"
 102   } else {
 103     if {[llength $bad] > 0} {
 104         set IsDone 0
 105         set TestError "$TestError # $Name naming failed at label $l2 sublabels $bad"
 106     }
 107   }
 108   NextLabel l1
 109   NextLabel l2
 110 }