1# -*- tcl -*- 2# (C) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> 3## 4# ### 5 6package require sak::test::shell 7package require sak::registry 8package require sak::animate 9package require sak::color 10# TODO: Rework this package to use the sak::feedback package 11 12getpackage textutil::repeat textutil/repeat.tcl 13getpackage fileutil fileutil/fileutil.tcl 14getpackage struct::matrix struct/matrix.tcl 15 16namespace eval ::sak::test::run { 17 namespace import ::textutil::repeat::blank 18 namespace import ::sak::color::* 19} 20 21# ### 22 23proc ::sak::test::run {argv} { 24 variable run::valgrind 25 array set config { 26 valgrind 0 raw 0 shells {} stem {} log 0 27 } 28 29 while {[string match -* [set opt [lindex $argv 0]]]} { 30 switch -exact -- $opt { 31 -s - --shell { 32 set sh [lindex $argv 1] 33 if {![fileutil::test $sh efrx msg "Shell"]} { 34 sak::test::usage $msg 35 } 36 lappend config(shells) $sh 37 set argv [lrange $argv 2 end] 38 } 39 -g - --valgrind { 40 if {![llength $valgrind]} { 41 sak::test::usage valgrind not found in the PATH 42 } 43 incr config(valgrind) 44 set argv [lrange $argv 1 end] 45 } 46 -v { 47 set config(raw) 1 48 set argv [lrange $argv 1 end] 49 } 50 -l - --log { 51 set config(log) 1 52 set config(stem) [lindex $argv 1] 53 set argv [lrange $argv 2 end] 54 } 55 default { 56 sak::test::usage Unknown option "\"$opt\"" 57 } 58 } 59 } 60 61 if {$config(log)} {set config(raw) 0} 62 63 if {![sak::util::checkModules argv]} return 64 65 run::Do config $argv 66 return 67} 68 69# ### 70 71proc ::sak::test::run::Do {cv modules} { 72 upvar 1 $cv config 73 variable valgrind 74 variable araw $config(raw) 75 variable alog $config(log) 76 # alog => !araw 77 78 set shells $config(shells) 79 if {![llength $shells]} { 80 catch {set shells [sak::test::shell::list]} 81 } 82 if {![llength $shells]} { 83 set shells [list [info nameofexecutable]] 84 } 85 86 if {$alog} { 87 variable logext [open $config(stem).log w] 88 variable logsum [open $config(stem).summary w] 89 variable logfai [open $config(stem).failures w] 90 variable logski [open $config(stem).skipped w] 91 variable lognon [open $config(stem).none w] 92 variable logerd [open $config(stem).errdetails w] 93 variable logfad [open $config(stem).faildetails w] 94 variable logtim [open $config(stem).timings w] 95 } else { 96 variable logext stdout 97 } 98 99 # Preprocessing of module names and shell versions to allows 100 # better formatting of the progress output, i.e. vertically 101 # aligned columns 102 103 if {!$araw} { 104 variable maxml 0 105 variable maxvl 0 106 sak::animate::init 107 foreach m $modules { 108 = "M $m" 109 set l [string length $m] 110 if {$l > $maxml} {set maxml $l} 111 } 112 foreach sh $shells { 113 = "SH $sh" 114 set v [exec $sh << {puts [info patchlevel]; exit}] 115 set l [string length $v] 116 if {$l > $maxvl} {set maxvl $l} 117 } 118 =| "Starting ..." 119 } 120 121 set total 0 122 set pass 0 123 set fail 0 124 set skip 0 125 set err 0 126 127 foreach sh $shells { 128 foreach m $modules { 129 set cmd [Command config $m $sh] 130 sak::animate::init 131 if {$alog || $araw} { 132 puts $logext ============================================================ 133 flush $logext 134 } 135 if {[catch {Close [Process [open |$cmd r+]]} msg]} { 136 incr err 137 =| "~~ [mag]ERR ${msg}[rst]" 138 if {$alog || $araw} { 139 puts $logext [mag]$msg[rst] 140 flush $logext 141 } 142 } 143 #sak::animate::last Ok 144 } 145 } 146 147 puts $logext "Passed [format %6d $pass] of [format %6d $total]" 148 puts $logext "Skipped [format %6d $skip] of [format %6d $total]" 149 150 if {$fail} { 151 puts $logext "Failed [red][format %6d $fail][rst] of [format %6d $total]" 152 } else { 153 puts $logext "Failed [format %6d $fail] of [format %6d $total]" 154 } 155 if {$err} { 156 puts $logext "#Errors [mag][format %6d $err][rst]" 157 } else { 158 puts $logext "#Errors [format %6d $err]" 159 } 160 161 if {$alog} { 162 variable xtimes 163 array set times $xtimes 164 165 struct::matrix M 166 M add columns 6 167 foreach k [lsort -dict [array names times]] { 168 #foreach {shell module testfile} $k break 169 foreach {testnum delta score} $times($k) break 170 M add row [linsert $k end $testnum $delta $score] 171 } 172 M sort rows -decreasing 5 173 174 M insert row 0 {Shell Module Testsuite Tests Seconds uSec/Test} 175 M insert row 1 {===== ====== ========= ===== ======= =========} 176 M add row {===== ====== ========= ===== ======= =========} 177 178 puts $logsum \nTimings... 179 puts $logsum [M format 2string] 180 } 181 182 exit [expr {($err || $fail) ? 1 : 0}] 183 return 184} 185 186# ### 187 188if {$::tcl_platform(platform) == "windows"} { 189 190 proc ::sak::test::run::Command {cv m sh} { 191 variable valgrind 192 upvar 1 $cv config 193 194 # Windows. Construction of the pipe to run a specific 195 # testsuite against a single shell. There is no valgrind to 196 # accomodate, and neither can we expect to have unix commands 197 # like 'echo' and 'cat' available. 'echo' we can go without. A 198 # 'cat' however is needed to merge stdout and stderr of the 199 # testsuite for processing here. We use an emuluation written 200 # in Tcl. 201 202 set catfile cat[pid].tcl 203 fileutil::writeFile $catfile { 204 catch {wm withdraw .} 205 while {![eof stdin]} {puts stdout [gets stdin]} 206 exit 207 } 208 209 set cmd "" 210 lappend cmd $sh 211 lappend cmd [Driver] -modules [list $m] 212 lappend cmd |& $sh $catfile 213 #puts <<$cmd>> 214 215 return $cmd 216 } 217 218 proc ::sak::test::run::Close {pipe} { 219 close $pipe 220 file delete cat[pid].tcl 221 return 222 } 223} else { 224 proc ::sak::test::run::Command {cv m sh} { 225 variable valgrind 226 upvar 1 $cv config 227 228 # Unix. Construction of the pipe to run a specific testsuite 229 # against a single shell. The command is constructed to work 230 # when using valgrind, and works when not using it as well. 231 232 set script {} 233 lappend script [list set argv [list -modules [list $m]]] 234 lappend script {set argc 2} 235 lappend script [list source [Driver]] 236 lappend script exit 237 238 set cmd "" 239 lappend cmd echo [join $script \n] 240 lappend cmd | 241 242 if {$config(valgrind)} { 243 foreach e $valgrind {lappend cmd $e} 244 if {$config(valgrind) > 1} { 245 lappend cmd --num-callers=8 246 lappend cmd --leak-resolution=high 247 lappend cmd -v --leak-check=yes 248 lappend cmd --show-reachable=yes 249 } 250 } 251 lappend cmd $sh 252 #lappend cmd >@ stdout 2>@ stderr 253 lappend cmd |& cat 254 #puts <<$cmd>> 255 256 return $cmd 257 } 258 259 proc ::sak::test::run::Close {pipe} { 260 close $pipe 261 return 262 } 263} 264 265# ### 266 267proc ::sak::test::run::Process {pipe} { 268 variable araw 269 variable alog 270 variable logext 271 while {1} { 272 if {[eof $pipe]} break 273 if {[gets $pipe line] < 0} break 274 if {$alog || $araw} {puts $logext $line ; flush $logext} 275 set rline $line 276 set line [string trim $line] 277 if {[string equal $line ""]} continue 278 Host; Platform 279 Cwd; Shell 280 Tcl 281 Start; End ; StartFile ; EndFile 282 Module; Testsuite 283 NoTestsuite 284 Support;Testing;Other 285 Summary 286 CaptureFailureSync ; # xcollect 1 => 2 287 CaptureFailureCollectBody ; # xcollect 2 => 3 => 5 288 CaptureFailureCollectActual ; # xcollect 3 => 4 289 CaptureFailureCollectExpected ; # xcollect 4 => 0 290 CaptureFailureCollectError ; # xcollect 5 => 0 291 CaptureStackStart 292 CaptureStack 293 294 TestStart 295 TestSkipped 296 TestPassed 297 TestFailed ; # xcollect => 1 298 299 SetupError 300 Aborted 301 AbortCause 302 303 Match||Skip||Sourced 304 # Unknown lines are printed 305 if {!$araw} {puts !$line} 306 } 307 return $pipe 308} 309 310# ### 311 312proc ::sak::test::run::Driver {} { 313 variable base 314 return [file join $base all.tcl] 315} 316 317# ### 318 319proc ::sak::test::run::Host {} { 320 upvar 1 line line ; variable xhost 321 if {![regexp "^@@ Host (.*)$" $line -> xhost]} return 322 # += $xhost 323 set xhost [list Tests Results $xhost] 324 #sak::registry::local set $xhost 325 return -code continue 326} 327 328proc ::sak::test::run::Platform {} { 329 upvar 1 line line ; variable xplatform 330 if {![regexp "^@@ Platform (.*)$" $line -> xplatform]} return 331 # += ($xplatform) 332 variable xhost 333 #sak::registry::local set $xhost Platform $xplatform 334 return -code continue 335} 336 337proc ::sak::test::run::Cwd {} { 338 upvar 1 line line ; variable xcwd 339 if {![regexp "^@@ CWD (.*)$" $line -> xcwd]} return 340 variable xhost 341 set xcwd [linsert $xhost end $xcwd] 342 #sak::registry::local set $xcwd 343 return -code continue 344} 345 346proc ::sak::test::run::Shell {} { 347 upvar 1 line line ; variable xshell 348 if {![regexp "^@@ Shell (.*)$" $line -> xshell]} return 349 # += [file tail $xshell] 350 variable xcwd 351 set xshell [linsert $xcwd end $xshell] 352 #sak::registry::local set $xshell 353 return -code continue 354} 355 356proc ::sak::test::run::Tcl {} { 357 upvar 1 line line ; variable xtcl 358 if {![regexp "^@@ Tcl (.*)$" $line -> xtcl]} return 359 variable xshell 360 variable maxvl 361 += \[$xtcl\][blank [expr {$maxvl - [string length $xtcl]}]] 362 #sak::registry::local set $xshell Tcl $xtcl 363 return -code continue 364} 365 366proc ::sak::test::run::Match||Skip||Sourced {} { 367 upvar 1 line line 368 if {[string match "@@ Skip*" $line]} {return -code continue} 369 if {[string match "@@ Match*" $line]} {return -code continue} 370 if {[string match "Sourced * Test Files." $line]} {return -code continue} 371 if {[string match "Files with failing tests*" $line]} {return -code continue} 372 if {[string match "Number of tests skipped*" $line]} {return -code continue} 373 if {[string match "\[0-9\]*" $line]} {return -code continue} 374 return 375} 376 377proc ::sak::test::run::Start {} { 378 upvar 1 line line 379 if {![regexp "^@@ Start (.*)$" $line -> start]} return 380 variable xshell 381 #sak::registry::local set $xshell Start $start 382 return -code continue 383} 384 385proc ::sak::test::run::End {} { 386 upvar 1 line line 387 if {![regexp "^@@ End (.*)$" $line -> end]} return 388 variable xshell 389 #sak::registry::local set $xshell End $end 390 return -code continue 391} 392 393proc ::sak::test::run::StartFile {} { 394 upvar 1 line line 395 if {![regexp "^@@ StartFile (.*)$" $line -> start]} return 396 variable xstartfile $start 397 variable xtestnum 0 398 #sak::registry::local set $xshell Start $start 399 return -code continue 400} 401 402proc ::sak::test::run::EndFile {} { 403 upvar 1 line line 404 if {![regexp "^@@ EndFile (.*)$" $line -> end]} return 405 variable xfile 406 variable xstartfile 407 variable xtimes 408 variable xtestnum 409 410 set k [lreplace $xfile 0 3] 411 set k [lreplace $k 2 2 [file tail [lindex $k 2]]] 412 set delta [expr {$end - $xstartfile}] 413 414 if {$xtestnum == 0} { 415 set score $delta 416 } else { 417 # average number of microseconds per test. 418 set score [expr {int(($delta/double($xtestnum))*1000000)}] 419 #set score [expr {$delta/double($xtestnum)}] 420 } 421 422 lappend xtimes $k [list $xtestnum $delta $score] 423 424 variable alog 425 if {$alog} { 426 variable logtim 427 puts $logtim [linsert [linsert $k end $xtestnum $delta $score] 0 TIME] 428 } 429 430 #sak::registry::local set $xshell End $end 431 return -code continue 432} 433 434proc ::sak::test::run::Module {} { 435 upvar 1 line line ; variable xmodule 436 if {![regexp "^@@ Module (.*)$" $line -> xmodule]} return 437 variable xshell 438 variable xstatus ok 439 variable maxml 440 += ${xmodule}[blank [expr {$maxml - [string length $xmodule]}]] 441 set xmodule [linsert $xshell end $xmodule] 442 #sak::registry::local set $xmodule 443 return -code continue 444} 445 446proc ::sak::test::run::Testsuite {} { 447 upvar 1 line line ; variable xfile 448 if {![regexp "^@@ Testsuite (.*)$" $line -> xfile]} return 449 = <[file tail $xfile]> 450 variable xmodule 451 set xfile [linsert $xmodule end $xfile] 452 #sak::registry::local set $xfile Aborted 0 453 return -code continue 454} 455 456proc ::sak::test::run::NoTestsuite {} { 457 upvar 1 line line 458 if {![string match "Error: No test files remain after*" $line]} return 459 variable xstatus none 460 = {No tests} 461 return -code continue 462} 463 464proc ::sak::test::run::Support {} { 465 upvar 1 line line 466 if {![regexp "^- (.*)$" $line -> package]} return 467 #= "S $package" 468 foreach {pn pv} $package break 469 variable xfile 470 #sak::registry::local set [linsert $xfile end Support] $pn $pv 471 return -code continue 472} 473 474proc ::sak::test::run::Testing {} { 475 upvar 1 line line 476 if {![regexp "^\\* (.*)$" $line -> package]} return 477 #= "T $package" 478 foreach {pn pv} $package break 479 variable xfile 480 #sak::registry::local set [linsert $xfile end Testing] $pn $pv 481 return -code continue 482} 483 484proc ::sak::test::run::Other {} { 485 upvar 1 line line 486 if {![string match ">*" $line]} return 487 return -code continue 488} 489 490proc ::sak::test::run::Summary {} { 491 upvar 1 line line 492 if {![regexp "^all\\.tcl:(.*)$" $line -> line]} return 493 variable xmodule 494 variable xstatus 495 variable xvstatus 496 foreach {_ t _ p _ s _ f} [split [string trim $line]] break 497 #sak::registry::local set $xmodule Total $t ; set t [format %5d $t] 498 #sak::registry::local set $xmodule Passed $p ; set p [format %5d $p] 499 #sak::registry::local set $xmodule Skipped $s ; set s [format %5d $s] 500 #sak::registry::local set $xmodule Failed $f ; set f [format %5d $f] 501 502 upvar 2 total _total ; incr _total $t 503 upvar 2 pass _pass ; incr _pass $p 504 upvar 2 skip _skip ; incr _skip $s 505 upvar 2 fail _fail ; incr _fail $f 506 upvar 2 err _err 507 508 set t [format %5d $t] 509 set p [format %5d $p] 510 set s [format %5d $s] 511 set f [format %5d $f] 512 513 if {$xstatus == "ok" && $t == 0} { 514 set xstatus none 515 } 516 517 set st $xvstatus($xstatus) 518 519 if {$xstatus == "ok"} { 520 # Quick return for ok suite. 521 =| "~~ $st T $t P $p S $s F $f" 522 return -code continue 523 } 524 525 # Clean out progress display using a non-highlighted 526 # string. Prevents the char couint from being off. This is 527 # followed by construction and display of the highlighted version. 528 529 = " $st T $t P $p S $s F $f" 530 switch -exact -- $xstatus { 531 none {=| "~~ [yel]$st T $t[rst] P $p S $s F $f"} 532 aborted {=| "~~ [whi]$st[rst] T $t P $p S $s F $f"} 533 error { 534 =| "~~ [mag]$st[rst] T $t P $p S $s F $f" 535 incr _err 536 } 537 fail {=| "~~ [red]$st[rst] T $t P $p S $s [red]F $f[rst]"} 538 } 539 return -code continue 540} 541 542proc ::sak::test::run::TestStart {} { 543 upvar 1 line line 544 if {![string match {---- * start} $line]} return 545 set testname [string range $line 5 end-6] 546 = "---- $testname" 547 variable xfile 548 variable xtest [linsert $xfile end $testname] 549 variable xtestnum 550 incr xtestnum 551 return -code continue 552} 553 554proc ::sak::test::run::TestSkipped {} { 555 upvar 1 line line 556 if {![string match {++++ * SKIPPED:*} $line]} return 557 regexp {^[^ ]* (.*)SKIPPED:.*$} $line -> testname 558 set testname [string trim $testname] 559 variable xtest 560 = "SKIP $testname" 561 if {$xtest == {}} { 562 variable xfile 563 set xtest [linsert $xfile end $testname] 564 } 565 #sak::registry::local set $xtest Status Skip 566 set xtest {} 567 return -code continue 568} 569 570proc ::sak::test::run::TestPassed {} { 571 upvar 1 line line 572 if {![string match {++++ * PASSED} $line]} return 573 set testname [string range $line 5 end-7] 574 variable xtest 575 = "PASS $testname" 576 if {$xtest == {}} { 577 variable xfile 578 set xtest [linsert $xfile end $testname] 579 } 580 #sak::registry::local set $xtest Status Pass 581 set xtest {} 582 return -code continue 583} 584 585proc ::sak::test::run::TestFailed {} { 586 upvar 1 line line 587 if {![string match {==== * FAILED} $line]} return 588 set testname [lindex [split [string range $line 5 end-7]] 0] 589 = "FAIL $testname" 590 variable xtest 591 if {$xtest == {}} { 592 variable xfile 593 set xtest [linsert $xfile end $testname] 594 } 595 #sak::registry::local set $xtest Status Fail 596 ## CAPTURE INIT 597 variable xcollect 1 598 variable xbody "" 599 variable xactual "" 600 variable xexpected "" 601 variable xstatus fail 602 # Ignore failed status if we already have it, or an error 603 # status. The latter is more important to show. We do override 604 # status 'aborted'. 605 if {$xstatus == "ok"} {set xstatus fail} 606 if {$xstatus == "aborted"} {set xstatus fail} 607 return -code continue 608} 609 610proc ::sak::test::run::CaptureFailureSync {} { 611 variable xcollect 612 if {$xcollect != 1} return 613 upvar 1 line line 614 if {![string match {==== Contents*} $line]} return 615 set xcollect 2 616 return -code continue 617} 618 619proc ::sak::test::run::CaptureFailureCollectBody {} { 620 variable xcollect 621 if {$xcollect != 2} return 622 upvar 1 rline line 623 variable xbody 624 if {[string match {---- Result was*} $line]} { 625 set xcollect 3 626 return -code continue 627 } elseif {[string match {---- Test generated error*} $line]} { 628 set xcollect 5 629 return -code continue 630 } 631 632 variable xbody 633 append xbody $line \n 634 return -code continue 635} 636 637proc ::sak::test::run::CaptureFailureCollectActual {} { 638 variable xcollect 639 if {$xcollect != 3} return 640 upvar 1 rline line 641 if {![string match {---- Result should*} $line]} { 642 variable xactual 643 append xactual $line \n 644 } else { 645 set xcollect 4 646 } 647 return -code continue 648} 649 650proc ::sak::test::run::CaptureFailureCollectExpected {} { 651 variable xcollect 652 if {$xcollect != 4} return 653 upvar 1 rline line 654 if {![string match {==== *} $line]} { 655 variable xexpected 656 append xexpected $line \n 657 } else { 658 variable alog 659 if {$alog} { 660 variable logfad 661 variable xtest 662 variable xbody 663 variable xactual 664 variable xexpected 665 666 puts $logfad "==== [lrange $xtest end-1 end] FAILED =========" 667 puts $logfad "==== Contents of test case:\n" 668 puts $logfad $xbody 669 670 puts $logfad "---- Result was:" 671 puts $logfad [string range $xactual 0 end-1] 672 673 puts $logfad "---- Result should have been:" 674 puts $logfad [string range $xexpected 0 end-1] 675 676 puts $logfad "==== [lrange $xtest end-1 end] ====\n\n" 677 flush $logfad 678 } 679 set xcollect 0 680 #sak::registry::local set $xtest Body $xbody 681 #sak::registry::local set $xtest Actual $xactual 682 #sak::registry::local set $xtest Expected $xexpected 683 set xtest {} 684 } 685 return -code continue 686} 687 688proc ::sak::test::run::CaptureFailureCollectError {} { 689 variable xcollect 690 if {$xcollect != 5} return 691 upvar 1 rline line 692 variable xbody 693 if {[string match {---- errorCode*} $line]} { 694 set xcollect 4 695 return -code continue 696 } 697 698 variable xactual 699 append xactual $line \n 700 return -code continue 701} 702 703proc ::sak::test::run::Aborted {} { 704 upvar 1 line line 705 if {![string match {Aborting the tests found *} $line]} return 706 variable xfile 707 variable xstatus 708 # Ignore aborted status if we already have it, or some other error 709 # status (like error, or fail). These are more important to show. 710 if {$xstatus == "ok"} {set xstatus aborted} 711 = Aborted 712 #sak::registry::local set $xfile Aborted {} 713 return -code continue 714} 715 716proc ::sak::test::run::AbortCause {} { 717 upvar 1 line line 718 if { 719 ![string match {Requiring *} $line] && 720 ![string match {Error in *} $line] 721 } return ; # {} 722 variable xfile 723 = $line 724 #sak::registry::local set $xfile Aborted $line 725 return -code continue 726} 727 728proc ::sak::test::run::CaptureStackStart {} { 729 upvar 1 line line 730 if {![string match {@+*} $line]} return 731 variable xstackcollect 1 732 variable xstack {} 733 variable xstatus error 734 = {Error, capturing stacktrace} 735 return -code continue 736} 737 738proc ::sak::test::run::CaptureStack {} { 739 variable xstackcollect 740 if {!$xstackcollect} return 741 upvar 1 line line 742 variable xstack 743 if {![string match {@-*} $line]} { 744 append xstack [string range $line 2 end] \n 745 } else { 746 set xstackcollect 0 747 variable xfile 748 variable alog 749 #sak::registry::local set $xfile Stacktrace $xstack 750 if {$alog} { 751 variable logerd 752 puts $logerd "[lindex $xfile end] StackTrace" 753 puts $logerd "========================================" 754 puts $logerd $xstack 755 puts $logerd "========================================\n\n" 756 flush $logerd 757 } 758 } 759 return -code continue 760} 761 762proc ::sak::test::run::SetupError {} { 763 upvar 1 line line 764 if {![string match {SETUP Error*} $line]} return 765 variable xstatus error 766 = {Setup error} 767 return -code continue 768} 769 770# ### 771 772proc ::sak::test::run::+= {string} { 773 variable araw 774 if {$araw} return 775 variable aprefix 776 append aprefix " " $string 777 sak::animate::next $aprefix 778 return 779} 780 781proc ::sak::test::run::= {string} { 782 variable araw 783 if {$araw} return 784 variable aprefix 785 sak::animate::next "$aprefix $string" 786 return 787} 788 789proc ::sak::test::run::=| {string} { 790 variable araw 791 if {$araw} return 792 variable aprefix 793 sak::animate::last "$aprefix $string" 794 variable alog 795 if {$alog} { 796 variable logsum 797 variable logfai 798 variable logski 799 variable lognon 800 variable xstatus 801 puts $logsum "$aprefix $string" ; flush $logsum 802 switch -exact -- $xstatus { 803 error - 804 fail {puts $logfai "$aprefix $string" ; flush $logfai} 805 none {puts $lognon "$aprefix $string" ; flush $lognon} 806 aborted {puts $logski "$aprefix $string" ; flush $logski} 807 } 808 } 809 set aprefix "" 810 return 811} 812 813# ### 814 815namespace eval ::sak::test::run { 816 variable base [file join $::distribution support devel] 817 variable valgrind [auto_execok valgrind] 818 819 # State of test processing. 820 821 variable xstackcollect 0 822 variable xstack {} 823 variable xcollect 0 824 variable xbody {} 825 variable xactual {} 826 variable xexpected {} 827 variable xhost {} 828 variable xplatform {} 829 variable xcwd {} 830 variable xshell {} 831 variable xmodule {} 832 variable xfile {} 833 variable xtest {} 834 variable xstartfile {} 835 variable xtimes {} 836 837 variable xstatus ok 838 839 # Animation prefix of test processing, and flag controlling the 840 # nature of logging (raw vs animation). 841 842 variable aprefix {} 843 variable araw 0 844 845 # Max length of module names and patchlevel information. 846 847 variable maxml 0 848 variable maxvl 0 849 850 # Map from internal stati to the displayed human readable 851 # strings. This includes the trailing whitespace needed for 852 # vertical alignment. 853 854 variable xvstatus 855 array set xvstatus { 856 ok { } 857 none {None } 858 aborted {Skip } 859 error {ERR } 860 fail {FAILS} 861 } 862} 863 864## 865# ### 866 867package provide sak::test::run 1.0 868 869if 0 { 870 # Bad valgrind, ok no valgrind 871 if {$config(valgrind)} { 872 foreach e $valgrind {lappend cmd $e} 873 lappend cmd --num-callers=8 874 lappend cmd --leak-resolution=high 875 lappend cmd -v --leak-check=yes 876 lappend cmd --show-reachable=yes 877 } 878 lappend cmd $sh 879 lappend cmd [Driver] -modules $modules 880} 881