Check-in [ef384673c5]

Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Added ability to push test execution into a child process, via a new command `kt::sub`. This is useful when each test in a set incurs a large memory penalty. Instead of adding up in the test process each is limited to the child process, keeping the test process small.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256:ef384673c572d13a94587090d2efc464412e38c14442a474620cac4783313af7
User & Date: aku 2018-04-18 02:28:17
Context
2018-07-10
22:01
path::tcl-package-file - Tweaked the critcl rejection patterns to make matching on Tcl data less likely. check-in: a0a7bf998d user: aku tags: trunk
2018-04-18
02:28
Added ability to push test execution into a child process, via a new command `kt::sub`. This is useful when each test in a set incurs a large memory penalty. Instead of adding up in the test process each is limited to the child process, keeping the test process small. check-in: ef384673c5 user: aku tags: trunk
2018-03-27
16:34
Tests use --include-dir to redirect the build into a local directory. This means that a build which needs additional include directories cannot have any during testing, making build for test impossible.

Added a --test-include option as a hack to provide such directories. check-in: e1656e5ba2 user: aku tags: trunk

Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to testmain.tcl.

1
2
3
4
5


6
7
8
9
10
11
12
..
14
15
16
17
18
19
20


21
22
23
24
25
26
27
..
51
52
53
54
55
56
57
58

59
60
61
62
63
64
65
66
67
68
69
70

























































71
72
73
74
75
76
77
78
# -*- tcl -*- Copyright (c) 2012 Andreas Kupries
# # ## ### ##### ######## ############# #####################
## Test Application (Entry point into .test files)
##
## argv = testfile (tcltest arguments ...)



# Kettle is designed to accomodate 8.5+
package require Tcl 8.5

# Accomodate use of wish as test shell.
catch {wm withdraw .}

................................................................................
## Get the kettle information before loading tcltest.
## Everything goes into the ::kt namespace to separate things from
## tcltest and others (the testsuite).

namespace eval ::kt {}

set argv  [lassign $argv kt::localprefix kt::testfile kt::mode]


set argv0 $kt::testfile

# # ## ### ##### ######## ############# #####################
## Import tcltest. This will process the remaining argv elements.
## All kettle argv elements must be processed before this point.

# Force full verbosity.
................................................................................
    wm withdraw .
}

# # ## ### ##### ######## ############# #####################
## Management utilities for communication with the 'test' recipe
## support code in our caller.

if {$kt::mode eq "scan"} {

    # Reduce reporting in scan mode.
    proc kt::Note {args} {}
} else {
    proc kt::Note {k v} {
	puts  stdout [list @@ $k $v]
	flush stdout
	return
    }
}

proc kt::Now {} {return [clock seconds]}


























































# Ensure an fully normalized absolute path to the test suite location.
set ::tcltest::testsDirectory \
    [file dirname [file normalize $::tcltest::testsDirectory]/___]

# # ## ### ##### ######## ############# #####################
## Start reporting, the environment in which the tests are run.

puts stdout ""
|



|
>
>







 







>
>







 







|
>
|











>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
..
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
..
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
# -*- tcl -*- Copyright (c) 2012-2018 Andreas Kupries
# # ## ### ##### ######## ############# #####################
## Test Application (Entry point into .test files)
##
## Syntax: <localprefix> <testfile> <mode> <options>
##         kt::localprefix kt::testfile kt::mode kt::argv
## mode in {scan, run}

# Kettle is designed to accomodate 8.5+
package require Tcl 8.5

# Accomodate use of wish as test shell.
catch {wm withdraw .}

................................................................................
## Get the kettle information before loading tcltest.
## Everything goes into the ::kt namespace to separate things from
## tcltest and others (the testsuite).

namespace eval ::kt {}

set argv  [lassign $argv kt::localprefix kt::testfile kt::mode]
set kt::main $argv0
set kt::argv $argv
set argv0 $kt::testfile

# # ## ### ##### ######## ############# #####################
## Import tcltest. This will process the remaining argv elements.
## All kettle argv elements must be processed before this point.

# Force full verbosity.
................................................................................
    wm withdraw .
}

# # ## ### ##### ######## ############# #####################
## Management utilities for communication with the 'test' recipe
## support code in our caller.

if {($kt::mode eq "scan") ||
    ($kt::mode eq "sub")} {
    # Prevent reporting in scan and sub modes.
    proc kt::Note {args} {}
} else {
    proc kt::Note {k v} {
	puts  stdout [list @@ $k $v]
	flush stdout
	return
    }
}

proc kt::Now {} {return [clock seconds]}

if {$kt::mode eq "scan"} {
    # In scan mode we must not report, even from a sub-shell.
    proc kt::Report {} {}
} elseif {$kt::mode eq "sub"} {
    # In a subshell the results have to be passed up the chain to the
    # caller for integration. See kt::sub below.
    proc kt::Report {} {
	variable ::tcltest::numTests
	variable ::tcltest::skippedBecause
	variable ::tcltest::createdNewFiles
	tcltest::makeFile \
	    [list tcltest::ReportedFromSlave \
		 $numTests(Total) $numTests(Passed) $numTests(Skipped) \
		 $numTests(Failed) [array get skippedBecause] \
		 [array get createdNewFiles]]\n \
	    report
	return
    }
}

# Place a test script into a sub-shell.
proc kt::sub {name script args} {
    # Build test file
    set data ""
    # Import the specified context (variables by name, and assignments).
    foreach v $args {
	if {[regexp {^([^=]*)=(.*)$} $v -> var val]} {
	    append data [list set $var $val]\n
	} else {
	    upvar 1 $v val
	    append data [list set $v $val]\n
	}
    }
    # Add the user's script, and report always, even in the presence of errors.
    append data "try \{\n"
    append data $script
    append data "\n\} finally \{\n"
    # See kt::Report above.
    append data kt::Report\n
    append data "\}\n"
    set path [tcltest::makeFile $data $name]
    # Run the file like we are run (same context and arguments, except
    # for mode.
    set mode sub
    if {$kt::mode eq "scan"} { set mode scan }
    try {
	exec 2>@ stderr >@ stdout [info nameofexecutable] $kt::main \
	    $kt::localprefix $path $mode {*}$kt::argv
	# Integrate the child's report into this process' statistics
	eval [viewFile report]
	tcltest::removeFile report
    } finally {
	tcltest::removeFile $path
    }
    return
}

# Ensure a fully normalized absolute path to the test suite location.
set ::tcltest::testsDirectory \
    [file dirname [file normalize $::tcltest::testsDirectory]/___]

# # ## ### ##### ######## ############# #####################
## Start reporting, the environment in which the tests are run.

puts stdout ""