src/DrawResources/Tests.tcl

   1 # Copyright (c) 1999-2012 OPEN CASCADE SAS
   2 #
   3 # The content of this file is subject to the Open CASCADE Technology Public
   4 # License Version 6.5 (the "License"). You may not use the content of this file
   5 # except in compliance with the License. Please obtain a copy of the License
   6 # at http://www.opencascade.org and read it completely before using this file.
   7 #
   8 # The Initial Developer of the Original Code is Open CASCADE S.A.S., having its
   9 # main offices at: 1, place des Freres Montgolfier, 78280 Guyancourt, France.
  10 #
  11 # The Original Code and all software distributed under the License is
  12 # distributed on an "AS IS" basis, without warranty of any kind, and the
  13 # Initial Developer hereby disclaims all such warranties, including without
  14 # limitation, any warranties of merchantability, fitness for a particular
  15 # purpose or non-infringement. Please see the License for the specific terms
  16 # and conditions governing the rights and limitations under the License.
  17
  18 #
  19 # tclsh tools to browse tests
  20 #
  21 # xab : 22-Mar-96  rajout de floatDifference pour eviter des diffs
  22 #                  en fonction de la tolerance DiffTestTolerance
  23 # pmn : 25-Sept-96 masterRoot sans reference explicite a gti
  24 #                 (pour une utilisation Aixoise)
  25 # xab : 12-Nov-996 nouveau trap dans les comptes rendus
  26 #                  INV par checkshape ou checktopshape
  27 # xab : 22/11/96  : on a encore besoin des 3 variables d'environement
  28 #                   WBCONTAINER
  29 #                   WBROOT
  30 #                   STATION
  31 # xab : 10-Mar-97 : string compare au lieu de != dans les diffs
  32 #
  33 ####################################################
  34 # Error list
  35 ####################################################
  36
  37 set nomatch "ZXWYWXZ"
  38 set theErrors {
  39     { nomatch                   "NOLOGFILE" "no result for the test"}
  40     { nomatch                   "OK       " "no error and no difference"}
  41     { nomatch                   "NO       " "no error and no master file to compare"}
  42     { nomatch                   "NOEND    " "abnormal termination"}
  43     { "An exception was caught" "CATCH    " "an exception was caught"}
  44     { "segv"                    "SEGV     " "segmentation violation"}
  45     { "ERROR"                   "ERROR    " "user generated error"}
  46     { "NYI"                     "NYI      " "This test is not yet implemented"}
  47     { "Cpu Limit Exceeded"      "CPULIM   " "CPU limit exceeded"}
  48     { "BRepCheck_"              "INV      " "invalid result"}
  49 }
  50
  51 ####################################################
  52 # Variables
  53 ####################################################
  54 set DiffTestTolerance 1.0e-6
  55
  56 set theStation $env(STATION)
  57
  58 if {$theStation=="wnt"} {
  59     set ExeMachinePath  drv\\DFLT\\$env(STATION)
  60     set exePath         $env(WBROOT)\\prod
  61 #    set testRoot        $env(WBCONTAINER)\\test
  62     set testRoot        $env(WBCONTAINER)
  63     set resultRoot      $env(WBROOT)\\work\\result$env(STATION)
  64     set masterRoot      $env(WBROOT)\\work\\master
  65 } else {
  66     set ExeMachinePath  drv/DFLT/$env(STATION)
  67     set ExePath         $env(WBROOT)/$env(STATION)/bin
  68     set testRoot        $env(WBCONTAINER)
  69     set resultRoot      $env(WBROOT)/work/result$env(STATION)
  70     set masterRoot      $env(WBROOT)/work/master
  71 }
  72 puts "$testRoot  et        $env(WBCONTAINER) "
  73 #
  74 ## customize default values, if "setenv" has been set by AQ Team  -plb/13feb97-
  75
  76 foreach el1 [array names env] {
  77     if       { [ string compare $el1 "DRAW_TEST_ROOT" ] == 0 }   {
  78         set testRoot   $env($el1)
  79     } elseif { [ string compare $el1 "DRAW_TEST_RESULT" ] == 0 } {
  80         set resultRoot $env($el1)
  81     } elseif { [ string compare $el1 "DRAW_TEST_MASTER" ] == 0 } {
  82         set masterRoot $env($el1)
  83     }
  84 }
  85
  86
  87 set theUL       ""
  88 set theFunction ""
  89 set theTest     ""
  90 set theExec     ""
  91 set themode     ""
  92
  93 # name of Draw process to send
  94 set theDraw     "Draw"
  95 set FILTRE      ""
  96 set DIFF        ""
  97 set RESULT      ""
  98 set PREVIOUS    ""
  99 set TEMP        ""
 100
 101 set listUL       {}
 102 set listFunction {}
 103 set listTest     {}
 104
 105 set theLog            ""
 106 set theMasterLog      ""
 107 set theXWDFiles       {}
 108 set theMasterXWDFiles {}
 109
 110 set theStatusHeader "Result    LOG  XWD"
 111 set theStatus       ""
 112 set theStatusLine   ""
 113 set theErrorLines   {}
 114 set theDiffs        {}
 115
 116
 117 ####################################################
 118 # List from a directory
 119 ####################################################
 120
 121 # match what is not a test
 122 set testRegExp \
 123         "^(Applet_GridTest|modeles|scripts|data|bin|help|begin.*|begin_wnt|end.*|grid|executables|readme|image|save|read.me|photo.*|.*~|#.*#)$"
 124
 125 proc mkListTests root {
 126     global testRegExp  Wok theStation env
 127     set l {}
 128
 129     if {$theStation=="wnt"} {
 130         foreach f [exec $env(WOKHOME)\\lib\\wnt\\ls.exe  $root] {
 131             set f [file tail $f]
 132             if [regexp $testRegExp $f] continue
 133                 lappend l $f
 134         }
 135     } else {
 136         foreach f [glob -nocomplain $root/*] {
 137             set f [file tail $f]
 138             if [regexp $testRegExp $f] continue
 139             lappend l $f
 140         }
 141     }
 142     return [lsort $l]
 143 }
 144
 145 ####################################################
 146 # Junky Heuristic to compare numbers in tests
 147 ####################################################
 148
 149 proc floatDifference { line1 line2 } {
 150     global DiffTestTolerance
 151     set has_number 0
 152     for { set ii 1 } { $ii <= 3 } { incr ii } {
 153         for { set jj 1 } { $jj <= 3 } { incr jj } {
 154             set number($ii,$jj) 0.0e0
 155         }
 156     }
 157     if { [regexp { ([0-9]+\.[0-9]+e-([0-9]+))|([0-9]+\.[0-9]*)} $line1  number(1,1) number(1,2) number(1,3) ] } {
 158         if { [regexp { ([0-9]+\.[0-9]+e-([0-9]+))|([0-9]+\.[0-9]*)} $line2 number(2,1) number(2,2)  number(2,3) ] } {
 159             for { set ii 1 } { $ii <= 3 } { incr ii } {
 160                 if { $number(1,$ii) != "" && $number(2,$ii) != "" } {
 161                     if { [ regexp {\.} $number(1,$ii) ] && [ regexp {\.} $number(2,$ii) ] } {
 162                         set has_number 1
 163                         set diff [ expr $number(1,$ii) - $number(2,$ii) ]
 164                         set diff [ expr abs($diff) ]
 165                         if { $diff > $DiffTestTolerance } {
 166                             return 1
 167
 168                         }
 169                     }
 170                 }
 171             }
 172
 173         }
 174     }
 175
 176 #
 177 # scabreux mais donne de bon resultat
 178 #
 179     if { $has_number } {
 180         return 0
 181     } else {
 182         return 1
 183     }
 184
 185 }
 186
 187 ####################################################
 188 # compute the current test status
 189 ####################################################
 190
 191 proc computeStatus {} {
 192     global testRoot resultRoot masterRoot
 193     global theUL theFunction theTest
 194     global theLog theMasterLog theXWDFiles theMasterXWDFiles
 195     global theErrors theStatus theStatusLine theErrorLines theDiffs
 196
 197     set hasresult [file readable $theLog]
 198     if {! $hasresult} {
 199         set theStatus     "-"
 200         set theStatusLine "NOLOGFILE"
 201         set theErrorLines {}
 202         set theDiffs      {}
 203         return
 204     }
 205     set hasmaster [file readable $theMasterLog]
 206
 207     # analyse the log file and compare to the master
 208     set curline    0
 209     set error      ""
 210     set errorlines {}
 211     set diffs      {}
 212     set completed  0
 213
 214     set f [open $theLog]
 215     if $hasmaster {set g [open $theMasterLog]}
 216     set moremaster $hasmaster
 217
 218
 219     while {[gets $f line] >= 0} {
 220         incr curline
 221         # difference with master
 222         if {$moremaster} {
 223             if {[gets $g mline] >= 0} {
 224                 # compare the two lines
 225                 if { [ string compare $line $mline ] } {
 226                     if { [ floatDifference  $mline $line  ] } {
 227                         lappend diffs $curline
 228                     }
 229                 }
 230             } else {
 231                 # the master file is finished
 232                 set moremaster 0
 233                 lappend ldiff $curline
 234             }
 235         }
 236
 237         # search for errors
 238         foreach err $theErrors {
 239             if [regexp [lindex $err 0] $line] {
 240                 if {[llength $errorlines] == 0} {set error [lindex $err 1]}
 241                 lappend errorlines $curline
 242             }
 243         }
 244
 245         # check for end of test
 246         if [regexp "TEST COMPLETED" $line] {
 247             set completed 1
 248         }
 249     }
 250
 251     close $f
 252     if $hasmaster {close $g}
 253
 254     set status "*"
 255     set statusline $error
 256     if {$error == ""} {
 257         if {! $completed} {
 258             set statusline "NOEND    "
 259         } else {
 260             set statusline "OK       "
 261             set status " "
 262         }
 263     }
 264
 265     if {$hasmaster} {
 266         if [llength $diffs] {
 267             append statusline " DIFF"
 268             set status "*"
 269         } else {
 270             append statusline " OK  "
 271         }
 272     } else {
 273             append statusline " NO  "
 274     }
 275
 276     # xwd files
 277
 278     if [llength $theXWDFiles] {
 279         # here we should compare the XWD files
 280         if [llength $theMasterXWDFiles] {
 281             append statusline " OK    "
 282         } else {
 283             append statusline " NO    "
 284         }
 285     } else {
 286             append statusline " NOXWD "
 287     }
 288
 289     # set results
 290
 291     set theStatus     $status
 292     set theStatusLine $statusline
 293     set theErrorLines $errorlines
 294     set theDiffs      $diffs
 295 }
 296
 297 ####################################################
 298 # trace on variables to update the lists
 299 ####################################################
 300
 301 trace variable theUL w theULProc
 302 proc theULProc {name element op} {
 303     global theUL testRoot listFunction
 304     global theStation
 305
 306     # Met a jour la liste des fonctions
 307     if {$theUL == ""} {
 308         set listFunction {}
 309     } else {
 310         set listFunction [mkListTests $testRoot/$theUL]
 311     }
 312 }
 313
 314 trace variable theFunction w theFunctionProc
 315 proc theFunctionProc {name element op} {
 316     global testRoot theUL theFunction listTest
 317     global theStation
 318
 319     # Met a jour la liste des tests
 320     if {$theFunction == ""} {
 321         set listTest {}
 322     } else {
 323         set listTest [mkListTests $testRoot/$theUL/$theFunction]
 324     }
 325 }
 326
 327 trace variable theTest w theTestProc
 328 proc theTestProc {name element op} {
 329     global resultRoot masterRoot theUL theFunction theTest
 330     global theLog theMasterLog theXWDFiles theMasterXWDFiles
 331     global theStation
 332
 333     if {$theStation=="wnt"} {
 334
 335         # update the result variables
 336         set theLog       $resultRoot\\$theUL\\$theFunction\\$theTest.log
 337         set theMasterLog $masterRoot\\$theUL\\$theFunction\\$theTest.log
 338
 339         set theXWDFiles \
 340                 [glob -nocomplain \
 341                 $resultRoot\\$theUL\\$theFunction\\${theTest}.*.xwd.Z]
 342
 343         set theMasterXWDFiles \
 344                 [glob -nocomplain \
 345                 $masterRoot\\$theUL\\$theFunction\\${theTest}.*.xwd.Z]
 346     } else {
 347         # update the result variables
 348         set theLog       $resultRoot/$theUL/$theFunction/$theTest.log
 349         set theMasterLog $masterRoot/$theUL/$theFunction/$theTest.log
 350
 351         set theXWDFiles \
 352                 [glob -nocomplain \
 353                 $resultRoot/$theUL/$theFunction/${theTest}.*.xwd.Z]
 354
 355         set theMasterXWDFiles \
 356                 [glob -nocomplain \
 357                 $masterRoot/$theUL/$theFunction/${theTest}.*.xwd.Z]
 358     }
 359
 360     # update the status
 361     computeStatus
 362 }
 363
 364 trace variable listUL w  listULProc
 365 proc listULProc {name element op} {
 366     global listUL theUL
 367     if [llength $listUL] {
 368         set theUL [lindex $listUL 0]
 369     } else {
 370         set theUL ""
 371     }
 372 }
 373
 374 trace variable listFunction w  listFunctionProc
 375 proc listFunctionProc {name element op} {
 376     global listFunction theFunction
 377     if [llength $listFunction] {
 378         set theFunction [lindex $listFunction 0]
 379     } else {
 380         set theFunction ""
 381     }
 382 }
 383
 384 trace variable listTest w  listTestProc
 385 proc listTestProc {name element op} {
 386     global listTest theTest
 387     if [llength $listTest] {
 388         set theTest [lindex $listTest 0]
 389     } else {
 390         set theTest ""
 391     }
 392 }
 393
 394 ####################################################
 395 # procedure to change test
 396 ####################################################
 397
 398 proc nextUL {} {
 399     global listUL theUL
 400     set l [llength $listUL]
 401     if ($l) {
 402         set i [lsearch $listUL $theUL]
 403         incr i
 404         if {$i < $l} {
 405             set theUL [lindex $listUL $i]
 406             return
 407         }
 408     }
 409     set theUL ""
 410 }
 411
 412 proc nextFunction {} {
 413     global listFunction theFunction
 414     set l [llength $listFunction]
 415     if ($l) {
 416         set i [lsearch $listFunction $theFunction]
 417         incr i
 418         if {$i < $l} {
 419             set theFunction [lindex $listFunction $i]
 420             return
 421         }
 422     }
 423     nextUL
 424 }
 425
 426 proc nextTest {} {
 427     global listTest theTest
 428     set l [llength $listTest]
 429     if ($l) {
 430         set i [lsearch $listTest $theTest]
 431         incr i
 432         if {$i < $l} {
 433             set theTest [lindex $listTest $i]
 434             return
 435         }
 436     }
 437     nextFunction
 438 }
 439
 440 proc nextWithResult {} {
 441     global theUL theTest theStatus
 442     while 1 {
 443         nextTest
 444         if {$theUL == ""} break
 445         if {$theTest == ""} continue
 446         if {$theStatus == "-"} continue
 447         break
 448     }
 449 }
 450
 451 proc nextWithError {} {
 452     global theStatus theUL
 453     while 1 {
 454         nextWithResult
 455         if {$theUL == ""} break
 456         if {$theStatus == "*"} break
 457     }
 458 }
 459
 460 ####################################################
 461 # run the current Test
 462 ####################################################
 463
 464 proc runTest {} {
 465     global themode theDraw Drawid
 466     global RESULT PREVIOUS TEMP DIFF FILTRE
 467     global testRoot resultRoot theExec theLog
 468     global theUL theFunction theTest
 469     global ExePath  ExeMachinePath
 470     global theStation theTmp theDrawHome theTmp1
 471     global cmdexec protect
 472     global testRootNT env
 473
 474
 475     puts "  theUL $theUL theFunction $theFunction test  $theTest "
 476     puts "thest == $theStation"
 477
 478     if {$theTest == ""} return
 479
 480     set exe $theExec
 481
 482     if {$exe == "" } {
 483
 484         if {$theStation=="wnt"} {
 485             set exe "${ExePath}\\T${theUL}\\${ExeMachinePath}\\T${theUL}"
 486         } else {
 487             set exe "${ExePath}/T${theUL}"
 488         }
 489     }
 490
 491     if {![file exists $resultRoot]} {
 492         if {$theStation=="wnt"} {
 493             set stat1 [catch {file mkdir $resultRoot} iscreated ]
 494             #       [exec $cmdexec $resultRoot]
 495         } else {
 496             catch {exec mkdir $resultRoot}
 497             catch {exec chmod 777 $resultRoot}
 498         }
 499     }
 500
 501     cd $resultRoot
 502
 503     if {![file isdirectory $resultRoot/$theUL]} {
 504         if { $theStation == "wnt" }  {
 505             set statpop [catch {file mkdir $resultRoot/$theUL} erreurfile ]
 506             if { $statpop != 0 } { puts "erreurfile == $erreurfile " }
 507             #       [exec $cmdexec $protect $theUL]
 508         } else {
 509             catch {exec mkdir $resultRoot/$theUL}
 510             catch {exec chmod 777 $resultRoot/$theUL}
 511         }
 512     }
 513
 514     cd $resultRoot/$theUL
 515
 516     if {![file isdirectory $resultRoot/$theUL/$theFunction]} {
 517         if {$theStation=="wnt"} {
 518             set stat1 [catch {file mkdir $resultRoot/$theUL/$theFunction} iscreated ]
 519             if {$stat1 != 0 } { puts "iscreated == $iscreated " }
 520             #           [exec $cmdexec $protect $theUL]
 521         } else {
 522             catch {exec mkdir $resultRoot/$theUL/$theFunction}
 523             catch {exec chmod 777 $resultRoot/$theUL/$theFunction}
 524         }
 525     }
 526     cd $resultRoot/$theUL/$theFunction
 527
 528     # run the test
 529     if {$theStation=="wnt"} {
 530         catch {file delete $theLog}
 531     } else {
 532         catch {exec rm -f $theLog}
 533     }
 534
 535     foreach f [glob -nocomplain ${theTest}.*.xwd.Z] {catch {exec $cmdexec $del $f}}
 536
 537
 538     if {$theStation=="wnt"} {
 539         set f  $resultRoot/$theUL/$theFunction/${theTest}[pid]
 540         set f1 $resultRoot/$theUL/$theFunction/${theTest}[pid]
 541         set ff [open $f1 w]
 542     } else {
 543         set f /tmp/theTest[pid]
 544         set ff [open $f w]
 545     }
 546     ## send current infos in "begin" script for customize by AQ Team  -plb/14feb97-
 547     puts $ff "set testinfos(resultRoot)  $resultRoot"
 548     puts $ff "set testinfos(theUL)       $theUL"
 549     puts $ff "set testinfos(theFunction) $theFunction"
 550     puts $ff "set testinfos(theTest)     $theTest"
 551     if {$themode == "samedraw"} {
 552         puts $ff "cd $resultRoot/$theUL/$theFunction"
 553     }
 554
 555     close $ff
 556
 557     puts "testRoot $testRoot"
 558
 559     cd $resultRoot/$theUL/$theFunction
 560
 561     if {$theStation=="wnt"} {
 562         set fff  $resultRoot/$theUL/$theFunction/${theTest}[pid]-pop
 563         set fpop [open $fff w]
 564         for_file line $f1                                    { puts $fpop $line }
 565         for_file line $testRoot/begin                        { puts $fpop $line }
 566         if {[file exist  $testRoot/$theUL/begin_wnt  ] } {
 567             for_file line $testRoot/$theUL/begin_wnt             { puts $fpop $line }
 568         }
 569         if {[file exist  $testRoot/$theUL/$theFunction/begin_wnt]} {
 570             for_file line $testRoot/$theUL/$theFunction/begin_wnt { puts $fpop $line }
 571         } else {
 572             if {[file exist  $testRoot/$theUL/$theFunction/begin]} {
 573                 for_file line $testRoot/$theUL/$theFunction/begin { puts $fpop $line }
 574             }
 575         }
 576         for_file line $testRoot/$theUL/$theFunction/$theTest { puts $fpop $line }
 577         if { [ file exists $testRoot/$theUL/end ] } {
 578             for_file line $testRoot/$theUL/end                   { puts $fpop $line }
 579         }
 580         if { [ file exists $testRoot/end ] } {
 581             for_file line $testRoot/end                          { puts $fpop $line }
 582         }
 583         puts $fpop "exit"
 584         if {[file exist $resultRoot/$theUL/$theFunction/${theTest}[pid] ] } {
 585             file delete $resultRoot/$theUL/$theFunction/${theTest}[pid]
 586         }
 587         close $fpop
 588         file copy $fff $f1
 589         file delet $fff
 590     } else {
 591         catch {exec cat -s \
 592                    $testRoot/begin \
 593                    $testRoot/$theUL/begin \
 594                    $testRoot/$theUL/$theFunction/begin \
 595                    $testRoot/$theUL/$theFunction/$theTest \
 596                    $testRoot/$theUL/$theFunction/end \
 597                    $testRoot/$theUL/end \
 598                    $testRoot/end >> $f}
 599
 600         set testroot $testRoot
 601     }
 602     if {$theStation=="wnt"} {
 603         set f3 $resultRoot/$theUL/$theFunction/${theTest}.log
 604         if { [file exists $f3] } { file delete $f3 }
 605         puts "l'executable == $exe"
 606         puts "testRoot == $testRoot"
 607         #puts "input  == $f1"
 608         #puts "output == $f3"
 609         catch { exec $exe -f $f1 -o $f3 } popstatus
 610         puts $popstatus
 611
 612     } else {
 613         if {$themode != "samedraw" } {
 614             catch { exec $exe -f $f >& ${theTest}.log }
 615         } else {
 616             # the draw est il toujours valide ?
 617             set myList [winfo interps]
 618             set DrawExists "0"
 619             for {set i 0} { $i < [expr [llength $myList]] } { incr i } {
 620                 set p [lindex $myList $i]
 621                 if {$p == $theDraw} {set DrawExists "1"}
 622             }
 623             if { $DrawExists == "0"} {
 624                 puts "Pas de Draw, on en lance un !!"
 625             }
 626             while { $DrawExists == "0"} {
 627                 set myList [winfo interps]
 628                 set mylen [llength $myList]
 629                 while { [catch { exec $theExec -l >& $RESULT & } message] } {
 630                     puts $message
 631                 }
 632                 set Drawid $message
 633                 # On espere avoir lance un draw, on recupere son nom
 634                 # comme on peut. La methode utilisee est extremement
 635                 # plantatoire, il faudrait pouvoir trouver le numero
 636                 # du process !?!
 637                 set i 0
 638                 while { $myList == [winfo interps] && [expr $i] < 20 } {
 639                     sleep 1
 640                     puts "1s d attente"
 641                     incr i
 642                 }
 643                 if {  [expr $i] < 20 } {
 644                     sleep 2
 645                     puts "2s d attente"
 646                     set newList [winfo interps]
 647                     set newlen [llength $newList]
 648                     set theDraw ""
 649                     puts $myList
 650                     puts $newList
 651                     for {set i 0} { $i < [expr $newlen] && !$DrawExists } { incr i } {
 652                         set DrawExists 1
 653                         set theDraw [lindex $newList $i]
 654                         for {set j 0} { $j < [expr $mylen]} {incr j} {
 655                             set p [lindex $myList $j]
 656                             if { $p == $theDraw} {
 657                                 set DrawExists 0
 658                             }
 659                         }
 660                     }
 661                 }
 662                 if { $DrawExists } {
 663                     puts "nouvelle appli : $theDraw"
 664                 } else {
 665                     puts "echec creation nouveau Draw, on recommence"
 666                     set theDraw ""
 667                     if { [catch { exec kill -9 $Drawid } mes] } {
 668                         puts $mes
 669                     } else {
 670                         puts "le process etait bien la, mais le Draw n est pas venu!?!"
 671                     }
 672                 }
 673             }
 674
 675             exec cp $RESULT $PREVIOUS
 676
 677             if { [catch {send $theDraw "source $f"} mes]} {
 678                 puts $mes
 679                 puts "on tue le Draw"
 680                 set theDraw ""
 681                 if { [catch { exec kill -9 $Drawid } mes] } { puts $mes }
 682             }
 683
 684             catch {exec $DIFF $PREVIOUS $RESULT > $TEMP}
 685             catch {exec cat $TEMP | $FILTRE >> ${theTest}.log}
 686         }
 687
 688     }
 689
 690
 691     if {$theStation=="wnt"} {
 692         catch {file delete $f1}
 693     } else {
 694         catch {exec rm -f $f}
 695     }
 696
 697     if { $theStation == "wnt" } {
 698         catch {exec $cmdexec attrib ${theTest}.log}
 699     } else {
 700         catch { exec chmod 666 ${theTest}.log }
 701     }
 702
 703
 704     # process photos
 705     foreach f [glob -nocomplain photo*] {
 706         set g $theTest.[string range $f 5 end].xwd
 707         puts "Processing $g"
 708         if {$theStation=="wnt"} {
 709             catch {exec $cmdexec $move $f $g}
 710         } else {
 711             catch { exec mv -f $f $g }
 712         }
 713         catch {exec compress $g}
 714         if {$theStation=="wnt"} {
 715             catch { exec $cmdexec attrib $g.Z }
 716         } else {
 717             catch { exec chmod 666 $g.Z }
 718         }
 719     }
 720
 721     #enforce update
 722     set theTest $theTest
 723 }
 724
 725 ####################################################
 726 # send the current test
 727 # to the process $theDraw
 728 ####################################################
 729
 730 proc sendTest {} {
 731     global testRoot resultRoot theExec theLog theDraw
 732     global theUL theFunction theTest
 733     global theStation
 734
 735     if {$theTest == ""} return
 736
 737     puts "Sending $theUL $theFunction $theTest to $theDraw"
 738     if {$theStation=="wnt"} {
 739         set f  $resultRoot\\\\$theUL\\\\$theFunction\\\\${theTest}[pid]
 740         set f1 $resultRoot\\\\$theUL\\\\$theFunction\\\\${theTest}[pid]
 741         set f2 $resultRoot\\\\$theUL\\\\$theFunction\\\\${theTest}.log
 742         set ff [open $f1 w]
 743         set gg [open $f2 w]
 744         #set ff2 [open $f2 w]
 745         puts $ff "set testroot $testRootNT"
 746     } else {
 747         set f /tmp/theTest[pid]
 748         set ff [open $f w]
 749         puts $ff "set testroot $testRoot"
 750     }
 751
 752 ## send current infos in "begin" script for customize by AQ Team  -plb/14feb97-
 753     puts $ff "set testinfos(resultRoot)  $resultRoot"
 754     puts $ff "set testinfos(theUL)       $theUL"
 755     puts $ff "set testinfos(theFunction) $theFunction"
 756     puts $ff "set testinfos(theTest)     $theTest"
 757     close $ff
 758
 759     if {$theStation=="wnt"} {
 760         set stat1 [catch {exec cmd /C copy /A \ $f1 + $testRoot\\begin + $testRoot\\$theUL\\begin_wnt + $testRoot\\$theUL\\$theFunction\\begin + $testRoot\\$theUL\\$theFunction\\$theTest + $testRoot\\$theUL\\$theFunction\\end + $testRoot\\$theUL\\end + $testRoot\\end + $f1} myerro]
 761         send $theDraw "source $f1"
 762     } else {
 763         catch {exec cat -s \
 764                    $testRoot/$theUL/begin \
 765                    $testRoot/$theUL/$theFunction/begin \
 766                    $testRoot/$theUL/$theFunction/$theTest \
 767                    $testRoot/$theUL/$theFunction/end \
 768                    $testRoot/$theUL/end  >> $f}
 769         send $theDraw "source $f"
 770     }
 771 }
 772
 773 ####################################################
 774 # clear result, copy master
 775 ####################################################
 776
 777 proc clearResult {} {
 778     global theTest theLog theXWDFiles
 779     catch {exec rm -f $theLog}
 780     foreach f  $theXWDFiles {catch {exec rm -f $f}}
 781
 782     #enforce update
 783     set theTest $theTest
 784 }
 785
 786 proc copyMaster {} {
 787
 788     global theLog theXWDFiles
 789     global theMasterLog theMasterXWDFiles
 790     global masterRoot theUL theFunction theTest
 791
 792     catch {exec rm -f $theMasterLog}
 793     foreach f $theMasterXWDFiles {catch {exec rm -f  $f}}
 794
 795     if {![file isdirectory $masterRoot/$theUL]} {
 796         if {$theStation=="wnt"} {
 797                 cd $masterRoot
 798                 file mkdir $theUL
 799                 #catch {exec $cmdexec mkdir $masterRoot\\$theUL}
 800                 #catch {exec $cmdexec $protect $masterRoot\\$theUL}
 801         } else {
 802             catch {exec mkdir $masterRoot/$theUL}
 803             catch {exec chmod 777 $masterRoot/$theUL}
 804         }
 805     }
 806
 807     if {![file isdirectory $masterRoot/$theUL/$theFunction]} {
 808         if {$theStation=="wnt"} {
 809                 cd $theUL
 810                 file mkdir $theFunction
 811                 #catch {exec $cmdexec mkdir $masterRoot\\$theUL\\$theFunction}
 812                 #catch {exec $cmdexec $protect $masterRoot\\$theUL\\$theFunction}
 813         } else {
 814             catch {exec mkdir $masterRoot/$theUL/$theFunction}
 815             catch {exec chmod 777 $masterRoot/$theUL/$theFunction}
 816         }
 817     }
 818
 819     if {$theStation=="wnt"} {set d $masterRoot\\$theUL\\$theFunction
 820 } else {set d $masterRoot/$theUL/$theFunction}
 821     if [file readable $theLog] {catch {exec cp $theLog $d}}
 822     foreach f $theXWDFiles {catch {exec cp $f $d}}
 823
 824     # enforce update
 825     set theTest $theTest
 826 }
 827
 828 ####################################################
 829 # Make the initial list of UL
 830 ####################################################
 831
 832 proc init {} {
 833     global listUL testRoot
 834     set listUL [mkListTests $testRoot]
 835 }