Check-in [788e5e66a9]

Not logged in

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

Overview
Comment:Extended testsuite support with --valgrind.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256:788e5e66a95af13df628dd005dedb6f3ae0351124f5d57ecf07958f724e474a2
User & Date: aku 2018-07-11 04:01:48
Context
2018-09-08
04:28
Extended test utilities - kt semi-local* : Search local first, then global - kt in : Change test directory context. check-in: 2416dce66e user: aku tags: trunk
2018-07-11
04:01
Extended testsuite support with --valgrind. check-in: 788e5e66a9 user: aku tags: trunk
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
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to path.tcl.

1
2
3
4
5
6
7
8
# -*- tcl -*- Copyright (c) 2012-2013 Andreas Kupries
# # ## ### ##### ######## ############# #####################
## Path utility commands.

namespace eval ::kettle::path {
    namespace export {[a-z]*}
    namespace ensemble create

|







1
2
3
4
5
6
7
8
# -*- tcl -*- Copyright (c) 2012-2018 Andreas Kupries
# # ## ### ##### ######## ############# #####################
## Path utility commands.

namespace eval ::kettle::path {
    namespace export {[a-z]*}
    namespace ensemble create

Changes to testmain.tcl.

15
16
17
18
19
20
21
22









23
24
25


26
27
28
29
30
31
32
...
114
115
116
117
118
119
120









121
122
123
124
125
126
127
128
129
130
# # ## ### ##### ######## ############# #####################
## 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.
lappend argv -verbose bpstenl
................................................................................
    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







|
>
>
>
>
>
>
>
>
>



>
>







 







>
>
>
>
>
>
>
>
>

|
<







15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
...
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142

143
144
145
146
147
148
149
# # ## ### ##### ######## ############# #####################
## 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]

# Check for valgrind
set valgrind 0
set pos [lsearch -exact $argv --valgrind]
if {$pos >= 0} {
    set argv [lreplace $argv $pos $pos]
    set valgrind 1
}

set kt::main $argv0
set kt::argv $argv
set argv0 $kt::testfile

#puts X_k[pid]\t[join $::auto_path \nX_k[pid]\t]

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

# Force full verbosity.
lappend argv -verbose bpstenl
................................................................................
    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 }

    if {$::valgrind} {
	lappend cmd [auto_execok valgrind]
    }
    lappend cmd [info nameofexecutable] $kt::main $kt::localprefix \
	$path $mode {*}$kt::argv
    if {$::valgrind} {
	lappend cmd --valgrind
    }
    try {
	exec 2>@ stderr >@ stdout {*}$cmd

	# Integrate the child's report into this process' statistics
	eval [viewFile report]
	tcltest::removeFile report
    } finally {
	tcltest::removeFile $path
    }
    return

Changes to testsuite.tcl.

1
2
3
4
5
6
7
8
..
26
27
28
29
30
31
32




33
34
35
36
37
38
39
40
41
42
43

44
45
46
47
48
49
50
...
175
176
177
178
179
180
181









182
183
184
185
186
187
188
...
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
...
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
# -*- tcl -*- Copyright (c) 2012 Andreas Kupries
# # ## ### ##### ######## ############# #####################
## Handle a tcltest-based testsuite

namespace eval ::kettle { namespace export testsuite }

kettle option define --constraints {
    Tcl list of constraints to activate.
................................................................................
kettle option define --notfile {
    Tcl list of glob patterns for test files to be skipped.
} {} listsimple

kettle option define --single {
    Run each test case completely independent.
} 0 boolean





kettle option define --tskip {
    Tcl list of glob patterns for tests to be skipped.
} {} listsimple

kettle option no-work-key --constraints
kettle option no-work-key --file
kettle option no-work-key --limitconstraints
kettle option no-work-key --tmatch
kettle option no-work-key --notfile
kettle option no-work-key --single

kettle option no-work-key --tskip

# # ## ### ##### ######## ############# #####################
## API.

proc ::kettle::testsuite {{testsrcdir tests}} {
    # Overwrite self, we run only once for effect.
................................................................................

    foreach t $testfiles pt [strutil padr $short] {
	dict set state fmap $t             $pt
	dict set state fmap [file tail $t] $pt
    }

    path in $srcdir {









	if {[option get --single]} {
	    dict set state singled 1 ;# Test::Summary

	    foreach test $testfiles {
		# change next to log/log
		#io note { io puts ${test}... }

................................................................................
		    dict set state summary 0
		    dict incr state numcases -1

		    stream aopen
		    path pipe line {
			io trace {TEST: $line}
			ProcessLine $line
		    } [option get --with-shell] $main $localprefix \
			$test run {*}$options -match $testcase
		}
	    }
	} else {
	    dict set state singled 0 ;# Test::Summary

	    foreach test $testfiles {
		# change next to log/log
................................................................................
		dict set state summary 0
		dict set state suite/status ok
		#dict set state 

		path pipe line {
		    io trace {TEST: $line}
		    ProcessLine $line
		} [option get --with-shell] $main $localprefix \
		    $test run {*}$options
	    }
	}
    }

    # Summary results...
    # ... the numbers
    set fn [dict get $state cfailed]
|







 







>
>
>
>











>







 







>
>
>
>
>
>
>
>
>







 







<
|







 







<
|







1
2
3
4
5
6
7
8
..
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
...
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
...
216
217
218
219
220
221
222

223
224
225
226
227
228
229
230
...
236
237
238
239
240
241
242

243
244
245
246
247
248
249
250
# -*- tcl -*- Copyright (c) 2012-2018 Andreas Kupries
# # ## ### ##### ######## ############# #####################
## Handle a tcltest-based testsuite

namespace eval ::kettle { namespace export testsuite }

kettle option define --constraints {
    Tcl list of constraints to activate.
................................................................................
kettle option define --notfile {
    Tcl list of glob patterns for test files to be skipped.
} {} listsimple

kettle option define --single {
    Run each test case completely independent.
} 0 boolean

kettle option define --valgrind {
    Run the tests under valgrind
} 0 boolean

kettle option define --tskip {
    Tcl list of glob patterns for tests to be skipped.
} {} listsimple

kettle option no-work-key --constraints
kettle option no-work-key --file
kettle option no-work-key --limitconstraints
kettle option no-work-key --tmatch
kettle option no-work-key --notfile
kettle option no-work-key --single
kettle option no-work-key --valgrind
kettle option no-work-key --tskip

# # ## ### ##### ######## ############# #####################
## API.

proc ::kettle::testsuite {{testsrcdir tests}} {
    # Overwrite self, we run only once for effect.
................................................................................

    foreach t $testfiles pt [strutil padr $short] {
	dict set state fmap $t             $pt
	dict set state fmap [file tail $t] $pt
    }

    path in $srcdir {
	set valgrind [option get --valgrind]
	if {$valgrind} {
	    lappend cmd {*}[auto_execok valgrind]
	}
	lappend cmd [option get --with-shell] $main $localprefix
	if {$valgrind} {
	    lappend options --valgrind
	}
	
	if {[option get --single]} {
	    dict set state singled 1 ;# Test::Summary

	    foreach test $testfiles {
		# change next to log/log
		#io note { io puts ${test}... }

................................................................................
		    dict set state summary 0
		    dict incr state numcases -1

		    stream aopen
		    path pipe line {
			io trace {TEST: $line}
			ProcessLine $line

		    } {*}$cmd $test run {*}$options -match $testcase
		}
	    }
	} else {
	    dict set state singled 0 ;# Test::Summary

	    foreach test $testfiles {
		# change next to log/log
................................................................................
		dict set state summary 0
		dict set state suite/status ok
		#dict set state 

		path pipe line {
		    io trace {TEST: $line}
		    ProcessLine $line

		} {*}$cmd $test run {*}$options
	    }
	}
    }

    # Summary results...
    # ... the numbers
    set fn [dict get $state cfailed]