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