mirror of
https://github.com/sqlite/sqlite.git
synced 2025-07-30 19:03:16 +03:00
Updates to testrunner.tcl so that it runs "make fuzztest" using multiple jobs.
FossilOrigin-Name: 7596ea7074e0ac73312586ed3d28cdacf97f54b8af73f804cbc8066c94d4b4ef
This commit is contained in:
dan
@ -1291,6 +1291,12 @@ fulltestonly: $(TESTPROGS) fuzztest
|
||||
./testfixture$(TEXE) $(TOP)/test/full.test
|
||||
|
||||
# Fuzz testing
|
||||
#
|
||||
# WARNING: When the "fuzztest" target is run by the testrunner.tcl script,
|
||||
# it does not actually run this code. Instead, it schedules equivalent
|
||||
# commands. Therefore, if this target is updated, then code in
|
||||
# testrunner_data.tcl (search for "trd_fuzztest_data") must also be updated.
|
||||
#
|
||||
fuzztest: fuzzcheck$(TEXE) $(FUZZDATA) sessionfuzz$(TEXE)
|
||||
./fuzzcheck$(TEXE) $(FUZZDATA)
|
||||
./sessionfuzz$(TEXE) run $(TOP)/test/sessionfuzz-data1.db
|
||||
|
||||
@ -9,7 +9,7 @@
|
||||
#
|
||||
#***********************************************************************
|
||||
#
|
||||
# TESTRUNNER: slow
|
||||
# TESTRUNNER: superslow
|
||||
#
|
||||
|
||||
source [file join [file dirname [info script]] fts5_common.tcl]
|
||||
@ -42,23 +42,4 @@ do_execsql_test 1.2 {
|
||||
SELECT count(*) FROM t1('mno')
|
||||
} $nLoop
|
||||
|
||||
do_execsql_test 2.0 {
|
||||
CREATE VIRTUAL TABLE t2 USING fts5(x);
|
||||
INSERT INTO t2(t2, rank) VALUES('pgsz', 32);
|
||||
}
|
||||
|
||||
do_test 2.1 {
|
||||
for {set ii 0} {$ii < $nLoop} {incr ii} {
|
||||
execsql {
|
||||
INSERT INTO t2 VALUES('abc def ghi');
|
||||
INSERT INTO t2 VALUES('jkl mno pqr');
|
||||
INSERT INTO t2(t2, rank) VALUES('merge', -1);
|
||||
}
|
||||
}
|
||||
} {}
|
||||
|
||||
do_execsql_test 2.2 {
|
||||
SELECT count(*) FROM t2('mno')
|
||||
} $nLoop
|
||||
|
||||
finish_test
|
||||
|
||||
45
ext/fts5/test/fts5optimize3.test
Normal file
45
ext/fts5/test/fts5optimize3.test
Normal file
@ -0,0 +1,45 @@
|
||||
# 2023 Aug 27
|
||||
#
|
||||
# The author disclaims copyright to this source code. In place of
|
||||
# a legal notice, here is a blessing:
|
||||
#
|
||||
# May you do good and not evil.
|
||||
# May you find forgiveness for yourself and forgive others.
|
||||
# May you share freely, never taking more than you give.
|
||||
#
|
||||
#***********************************************************************
|
||||
#
|
||||
# TESTRUNNER: superslow
|
||||
#
|
||||
|
||||
source [file join [file dirname [info script]] fts5_common.tcl]
|
||||
set testprefix fts5optimize2
|
||||
|
||||
# If SQLITE_ENABLE_FTS5 is defined, omit this file.
|
||||
ifcapable !fts5 {
|
||||
finish_test
|
||||
return
|
||||
}
|
||||
|
||||
set nLoop 2500
|
||||
|
||||
do_execsql_test 1.0 {
|
||||
CREATE VIRTUAL TABLE t2 USING fts5(x);
|
||||
INSERT INTO t2(t2, rank) VALUES('pgsz', 32);
|
||||
}
|
||||
|
||||
do_test 1.1 {
|
||||
for {set ii 0} {$ii < $nLoop} {incr ii} {
|
||||
execsql {
|
||||
INSERT INTO t2 VALUES('abc def ghi');
|
||||
INSERT INTO t2 VALUES('jkl mno pqr');
|
||||
INSERT INTO t2(t2, rank) VALUES('merge', -1);
|
||||
}
|
||||
}
|
||||
} {}
|
||||
|
||||
do_execsql_test 1.2 {
|
||||
SELECT count(*) FROM t2('mno')
|
||||
} $nLoop
|
||||
|
||||
finish_test
|
||||
21
manifest
21
manifest
@ -1,9 +1,9 @@
|
||||
C Whether\sor\snot\sOOM\sis\salways\sfatal\sin\sJNI\sis\snow\sa\scompile-time\soption.
|
||||
D 2023-08-26T21:02:50.002
|
||||
C Updates\sto\stestrunner.tcl\sso\sthat\sit\sruns\s"make\sfuzztest"\susing\smultiple\sjobs.
|
||||
D 2023-08-26T21:04:54.521
|
||||
F .fossil-settings/empty-dirs dbb81e8fc0401ac46a1491ab34a7f2c7c0452f2f06b54ebb845d024ca8283ef1
|
||||
F .fossil-settings/ignore-glob 35175cdfcf539b2318cb04a9901442804be81cd677d8b889fcc9149c21f239ea
|
||||
F LICENSE.md df5091916dbb40e6e9686186587125e1b2ff51f022cc334e886c19a0e9982724
|
||||
F Makefile.in 577177569fa57e613b74f60d66b03cd16e4326439dd62fd5b9690f5b83c34bf0
|
||||
F Makefile.in 345a8599cf8ff015db534cedad7af70a1a6c36e295b85d720966c18af836ed30
|
||||
F Makefile.linux-gcc f3842a0b1efbfbb74ac0ef60e56b301836d05b4d867d014f714fa750048f1ab6
|
||||
F Makefile.msc 26c2d196391a285c279adb10fd6001774d9b243af94b700b681e4a49cd476684
|
||||
F README.md 963d30019abf0cc06b263cd2824bce022893f3f93a531758f6f04ff2194a16a8
|
||||
@ -185,7 +185,8 @@ F ext/fts5/test/fts5multiclient.test 5ff811c028d6108045ffef737f1e9f05028af2458e4
|
||||
F ext/fts5/test/fts5near.test 211477940142d733ac04fad97cb24095513ab2507073a99c2765c3ddd2ef58bd
|
||||
F ext/fts5/test/fts5onepass.test f9b7d9b2c334900c6542a869760290e2ab5382af8fbd618834bf1fcc3e7b84da
|
||||
F ext/fts5/test/fts5optimize.test 36a752d24c818792032e4ff502936fc9cc5ef938721696396fdc79214b2717f1
|
||||
F ext/fts5/test/fts5optimize2.test c7c97693abe8a2cb572acfb1f252d78f03d3984094cfc5eb2285a76d8a702a92
|
||||
F ext/fts5/test/fts5optimize2.test 93e742c36b487d8874621360af5b1ce4d39b04fb9e71ce9bc34015c5fc811785
|
||||
F ext/fts5/test/fts5optimize3.test bf9c91bb927d0fb2b9a06318a217a0419183ac5913842e062c7e0b98ea5d0fca
|
||||
F ext/fts5/test/fts5phrase.test 13e5d8e9083077b3d9c74315b3c92ec723cc6eb37c8155e0bfe1bba00559f07b
|
||||
F ext/fts5/test/fts5plan.test b65cfcca9ddd6fdaa118c61e17aeec8e8433bc5b6bb307abd116514f79c49c5a
|
||||
F ext/fts5/test/fts5porter.test 8d08010c28527db66bc3feebd2b8767504aaeb9b101a986342fa7833d49d0d15
|
||||
@ -1614,8 +1615,8 @@ F test/temptable2.test 76821347810ecc88203e6ef0dd6897b6036ac788e9dd3e6b04fd4d163
|
||||
F test/temptable3.test d11a0974e52b347e45ee54ef1923c91ed91e4637
|
||||
F test/temptrigger.test 38f0ca479b1822d3117069e014daabcaacefffcc
|
||||
F test/tester.tcl 68454ef88508c196d19e8694daa27bff7107a91857799eaa12f417188ae53ede
|
||||
F test/testrunner.tcl ccdfda84732cf8665bd8d3bfee79b80841e221459e5d00a632a3a5c758966e1f
|
||||
F test/testrunner_data.tcl c448693eb6fdbadb78cb26f6253d4f335666f9836f988afa575de960b666b19f
|
||||
F test/testrunner.tcl 1a1a000d486b3f0dfb6c78b425c64bf400fa0c75d1058e7b3ce6e23047f5cdaa
|
||||
F test/testrunner_data.tcl fdcc95d995fd1ef8bbaac1bc105988016213037038161bb555100439793ada18
|
||||
F test/thread001.test a0985c117eab62c0c65526e9fa5d1360dd1cac5b03bde223902763274ce21899
|
||||
F test/thread002.test c24c83408e35ba5a952a3638b7ac03ccdf1ce4409289c54a050ac4c5f1de7502
|
||||
F test/thread003.test ee4c9efc3b86a6a2767516a37bd64251272560a7
|
||||
@ -2103,8 +2104,8 @@ F vsixtest/vsixtest.tcl 6a9a6ab600c25a91a7acc6293828957a386a8a93
|
||||
F vsixtest/vsixtest.vcxproj.data 2ed517e100c66dc455b492e1a33350c1b20fbcdc
|
||||
F vsixtest/vsixtest.vcxproj.filters 37e51ffedcdb064aad6ff33b6148725226cd608e
|
||||
F vsixtest/vsixtest_TemporaryKey.pfx e5b1b036facdb453873e7084e1cae9102ccc67a0
|
||||
P 4252f56f3d8574b7b43306440726daf3b5f5500d5d9105784b2f82753e7c71dd
|
||||
R 73a65c0a564c2b6325f39c30c9023371
|
||||
U stephan
|
||||
Z c1a9d88eb5b30bcb5f8055b2c7e2b244
|
||||
P 320a34c080d8bc1feae1578697923dfa7c4144b78de36f704c24cc4a4ce9d535
|
||||
R 386688df896b64f3b42ccef0d10cea60
|
||||
U dan
|
||||
Z 8aa57743124b4e556d29bb22c82a5c1a
|
||||
# Remove this line to create a well-formed Fossil manifest.
|
||||
|
||||
@ -1 +1 @@
|
||||
320a34c080d8bc1feae1578697923dfa7c4144b78de36f704c24cc4a4ce9d535
|
||||
7596ea7074e0ac73312586ed3d28cdacf97f54b8af73f804cbc8066c94d4b4ef
|
||||
@ -59,7 +59,6 @@ Usage:
|
||||
|
||||
where SWITCHES are:
|
||||
--jobs NUMBER-OF-JOBS
|
||||
--fuzztest
|
||||
--zipvfs ZIPVFS-SOURCE-DIR
|
||||
|
||||
Interesting values for PERMUTATION are:
|
||||
@ -83,11 +82,6 @@ If a PERMUTATION is specified and is followed by the path to a Tcl script
|
||||
instead of a list of patterns, then that single Tcl test script is run
|
||||
with the specified permutation.
|
||||
|
||||
The --fuzztest option is ignored if the PERMUTATION is "release". Otherwise,
|
||||
if it is present, then "make -C <dir> fuzztest" is run as part of the tests,
|
||||
where <dir> is the directory containing the testfixture binary used to
|
||||
run the script.
|
||||
|
||||
The "status" and "njob" commands are designed to be run from the same
|
||||
directory as a running testrunner.tcl script that is running tests. The
|
||||
"status" command prints a report describing the current state and progress
|
||||
@ -160,16 +154,19 @@ switch -nocase -glob -- $tcl_platform(os) {
|
||||
set TRG(platform) osx
|
||||
set TRG(make) make.sh
|
||||
set TRG(makecmd) "bash make.sh"
|
||||
set TRG(testfixture) testfixture
|
||||
}
|
||||
*linux* {
|
||||
set TRG(platform) linux
|
||||
set TRG(make) make.sh
|
||||
set TRG(makecmd) "bash make.sh"
|
||||
set TRG(testfixture) testfixture
|
||||
}
|
||||
*win* {
|
||||
set TRG(platform) win
|
||||
set TRG(make) make.bat
|
||||
set TRG(makecmd) make.bat
|
||||
set TRG(testfixture) testfixture.exe
|
||||
}
|
||||
default {
|
||||
error "cannot determine platform!"
|
||||
@ -181,20 +178,30 @@ switch -nocase -glob -- $tcl_platform(os) {
|
||||
# The database schema used by the testrunner.db database.
|
||||
#
|
||||
set TRG(schema) {
|
||||
DROP TABLE IF EXISTS script;
|
||||
DROP TABLE IF EXISTS jobs;
|
||||
DROP TABLE IF EXISTS config;
|
||||
|
||||
CREATE TABLE script(
|
||||
build TEXT DEFAULT '',
|
||||
config TEXT,
|
||||
filename TEXT, -- full path to test script
|
||||
slow BOOLEAN, -- true if script is "slow"
|
||||
/*
|
||||
** This table contains one row for each job that testrunner.tcl must run
|
||||
** before the entire test run is finished.
|
||||
*/
|
||||
CREATE TABLE jobs(
|
||||
/* Fields populated when db is initialized */
|
||||
jobid INTEGER PRIMARY KEY, -- id to identify job
|
||||
displaytype TEXT NOT NULL, -- Type of test (for one line report)
|
||||
displayname TEXT NOT NULL, -- Human readable job name
|
||||
build TEXT NOT NULL DEFAULT '', -- make.sh/make.bat file request, if any
|
||||
dirname TEXT NOT NULL DEFAULT '', -- directory name, if required
|
||||
cmd TEXT NOT NULL, -- shell command to run
|
||||
depid INTEGER, -- identifier of dependency (or '')
|
||||
copydir TEXT, -- copy files from here
|
||||
priority INTEGER NOT NULL, -- higher priority jobs may run earlier
|
||||
|
||||
/* Fields updated as jobs run */
|
||||
starttime INTEGER,
|
||||
endtime INTEGER,
|
||||
state TEXT CHECK( state IN ('', 'ready', 'running', 'done', 'failed') ),
|
||||
time INTEGER, -- Time in ms
|
||||
output TEXT, -- full output of test script
|
||||
priority INTEGER,
|
||||
jobtype TEXT CHECK( jobtype IN ('script', 'build', 'make') ),
|
||||
PRIMARY KEY(build, config, filename)
|
||||
output TEXT
|
||||
);
|
||||
|
||||
CREATE TABLE config(
|
||||
@ -202,8 +209,8 @@ set TRG(schema) {
|
||||
value
|
||||
) WITHOUT ROWID;
|
||||
|
||||
CREATE INDEX i1 ON script(state, jobtype);
|
||||
CREATE INDEX i2 ON script(state, priority);
|
||||
CREATE INDEX i1 ON jobs(state, priority);
|
||||
CREATE INDEX i2 ON jobs(depid);
|
||||
}
|
||||
#-------------------------------------------------------------------------
|
||||
|
||||
@ -303,39 +310,14 @@ if {[llength $argv]==1
|
||||
&& [string compare -nocase status [lindex $argv 0]]==0
|
||||
} {
|
||||
|
||||
proc display_job {build config filename {tm ""}} {
|
||||
if {$config=="build"} {
|
||||
set fname "build: $filename"
|
||||
set config ""
|
||||
} elseif {$config=="make"} {
|
||||
set fname "make: $filename"
|
||||
set config ""
|
||||
} else {
|
||||
set fname [file normalize $filename]
|
||||
if {[string first $::srcdir $fname]==0} {
|
||||
set fname [string range $fname [string length $::srcdir]+1 end]
|
||||
}
|
||||
}
|
||||
set dfname [format %-33s $fname]
|
||||
proc display_job {jobdict {tm ""}} {
|
||||
array set job $jobdict
|
||||
|
||||
set dfname [format %-60s $job(displayname)]
|
||||
|
||||
set dbuild ""
|
||||
set dconfig ""
|
||||
set dparams ""
|
||||
set dtm ""
|
||||
if {$build!=""} { set dbuild $build }
|
||||
if {$config!="" && $config!="full"} { set dconfig $config }
|
||||
if {$dbuild!="" || $dconfig!=""} {
|
||||
append dparams "("
|
||||
if {$dbuild!=""} {append dparams "build=$dbuild"}
|
||||
if {$dbuild!="" && $dconfig!=""} {append dparams " "}
|
||||
if {$dconfig!=""} {append dparams "config=$dconfig"}
|
||||
append dparams ")"
|
||||
set dparams [format %-33s $dparams]
|
||||
}
|
||||
if {$tm!=""} {
|
||||
set dtm "\[${tm}ms\]"
|
||||
}
|
||||
puts " $dfname $dparams $dtm"
|
||||
if {$tm!=""} { set dtm "\[[expr {$tm-$job(starttime)}]ms\]" }
|
||||
puts " $dfname $dtm"
|
||||
}
|
||||
|
||||
sqlite3 mydb $TRG(dbname)
|
||||
@ -355,7 +337,7 @@ if {[llength $argv]==1
|
||||
set total 0
|
||||
foreach s {"" ready running done failed} { set S($s) 0 }
|
||||
mydb eval {
|
||||
SELECT state, count(*) AS cnt FROM script GROUP BY 1
|
||||
SELECT state, count(*) AS cnt FROM jobs GROUP BY 1
|
||||
} {
|
||||
incr S($state) $cnt
|
||||
incr total $cnt
|
||||
@ -375,19 +357,17 @@ if {[llength $argv]==1
|
||||
if {$S(running)>0} {
|
||||
puts "Running: "
|
||||
mydb eval {
|
||||
SELECT build, config, filename, time FROM script WHERE state='running'
|
||||
ORDER BY time
|
||||
} {
|
||||
display_job $build $config $filename [expr $now-$time]
|
||||
SELECT * FROM jobs WHERE state='running' ORDER BY starttime
|
||||
} job {
|
||||
display_job [array get job] $now
|
||||
}
|
||||
}
|
||||
if {$S(failed)>0} {
|
||||
puts "Failures: "
|
||||
mydb eval {
|
||||
SELECT build, config, filename FROM script WHERE state='failed'
|
||||
ORDER BY 3
|
||||
} {
|
||||
display_job $build $config $filename
|
||||
SELECT * FROM jobs WHERE state='failed' ORDER BY starttime
|
||||
} job {
|
||||
display_job [array get job]
|
||||
}
|
||||
}
|
||||
|
||||
@ -408,8 +388,6 @@ for {set ii 0} {$ii < [llength $argv]} {incr ii} {
|
||||
incr ii
|
||||
set TRG(nJob) [lindex $argv $ii]
|
||||
if {$isLast} { usage }
|
||||
} elseif {($n>2 && [string match "$a*" --fuzztest]) || $a=="-f"} {
|
||||
set TRG(fuzztest) 1
|
||||
} elseif {($n>2 && [string match "$a*" --zipvfs]) || $a=="-z"} {
|
||||
incr ii
|
||||
set TRG(zipvfs) [lindex $argv $ii]
|
||||
@ -492,108 +470,6 @@ proc build_to_dirname {bname} {
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------------
|
||||
# Return a list of tests to run. Each element of the list is itself a
|
||||
# list of two elements - the name of a permuations.test configuration
|
||||
# followed by the full path to a test script. i.e.:
|
||||
#
|
||||
# {BUILD CONFIG FILENAME} {BUILD CONFIG FILENAME} ...
|
||||
#
|
||||
proc testset_patternlist {patternlist} {
|
||||
global TRG
|
||||
|
||||
set testset [list] ;# return value
|
||||
|
||||
set first [lindex $patternlist 0]
|
||||
|
||||
if {$first=="sdevtest" || $first=="mdevtest"} {
|
||||
set CONFIGS(sdevtest) {All-Debug All-Sanitize}
|
||||
set CONFIGS(mdevtest) {All-Debug All-O0}
|
||||
|
||||
set patternlist [lrange $patternlist 1 end]
|
||||
|
||||
foreach b $CONFIGS($first) {
|
||||
lappend testset [list $b build testfixture]
|
||||
lappend testset [list $b make fuzztest]
|
||||
testset_append testset $b veryquick $patternlist
|
||||
}
|
||||
} elseif {$first=="release"} {
|
||||
set platform $::TRG(platform)
|
||||
|
||||
set patternlist [lrange $patternlist 1 end]
|
||||
foreach b [trd_builds $platform] {
|
||||
foreach c [trd_configs $platform $b] {
|
||||
testset_append testset $b $c $patternlist
|
||||
}
|
||||
|
||||
if {[llength $patternlist]==0 || $b=="User-Auth"} {
|
||||
set target testfixture
|
||||
} else {
|
||||
set target coretestprogs
|
||||
}
|
||||
lappend testset [list $b build $target]
|
||||
}
|
||||
|
||||
if {[llength $patternlist]==0} {
|
||||
foreach b [trd_builds $platform] {
|
||||
foreach e [trd_extras $platform $b] {
|
||||
lappend testset [list $b make $e]
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
set TRG(fuzztest) 0 ;# ignore --fuzztest option in this case
|
||||
|
||||
} elseif {$first=="all"} {
|
||||
|
||||
set clist [trd_all_configs]
|
||||
set patternlist [lrange $patternlist 1 end]
|
||||
foreach c $clist {
|
||||
testset_append testset "" $c $patternlist
|
||||
}
|
||||
|
||||
} elseif {[info exists ::testspec($first)]} {
|
||||
set clist $first
|
||||
testset_append testset "" $first [lrange $patternlist 1 end]
|
||||
} elseif { [llength $patternlist]==0 } {
|
||||
testset_append testset "" veryquick $patternlist
|
||||
} else {
|
||||
testset_append testset "" full $patternlist
|
||||
}
|
||||
if {$TRG(fuzztest)} {
|
||||
if {$TRG(platform)=="win"} { error "todo" }
|
||||
lappend testset [list "" make fuzztest]
|
||||
}
|
||||
|
||||
set testset
|
||||
}
|
||||
|
||||
proc testset_append {listvar build config patternlist} {
|
||||
upvar $listvar lvar
|
||||
|
||||
catch { array unset O }
|
||||
array set O $::testspec($config)
|
||||
|
||||
foreach f $O(-files) {
|
||||
if {[llength $patternlist]>0} {
|
||||
set bMatch 0
|
||||
foreach p $patternlist {
|
||||
if {[string match $p [file tail $f]]} {
|
||||
set bMatch 1
|
||||
break
|
||||
}
|
||||
}
|
||||
if {$bMatch==0} continue
|
||||
}
|
||||
|
||||
if {[file pathtype $f]!="absolute"} {
|
||||
set f [file join $::testdir $f]
|
||||
}
|
||||
lappend lvar [list $build $config $f]
|
||||
}
|
||||
}
|
||||
|
||||
#--------------------------------------------------------------------------
|
||||
|
||||
|
||||
proc r_write_db {tcl} {
|
||||
trdb eval { BEGIN EXCLUSIVE }
|
||||
@ -615,54 +491,299 @@ proc r_get_next_job {iJob} {
|
||||
set orderby "ORDER BY priority DESC"
|
||||
}
|
||||
|
||||
set ret [list]
|
||||
|
||||
r_write_db {
|
||||
set f ""
|
||||
set c ""
|
||||
trdb eval "
|
||||
SELECT build, config, filename
|
||||
FROM script
|
||||
WHERE state='ready'
|
||||
$orderby LIMIT 1
|
||||
" {
|
||||
set b $build
|
||||
set c $config
|
||||
set f $filename
|
||||
}
|
||||
if {$f!=""} {
|
||||
set query "
|
||||
SELECT * FROM jobs AS j WHERE state='ready' $orderby LIMIT 1
|
||||
"
|
||||
trdb eval $query job {
|
||||
set tm [clock_milliseconds]
|
||||
set T($iJob) $tm
|
||||
set jobid $job(jobid)
|
||||
|
||||
trdb eval {
|
||||
UPDATE script SET state='running', time=$tm
|
||||
WHERE (build, config, filename) = ($b, $c, $f)
|
||||
UPDATE jobs SET starttime=$tm, state='running' WHERE jobid=$jobid
|
||||
}
|
||||
|
||||
set ret [array get job]
|
||||
}
|
||||
}
|
||||
|
||||
if {$f==""} { return "" }
|
||||
list $b $c $f
|
||||
return $ret
|
||||
}
|
||||
|
||||
#rename r_get_next_job r_get_next_job_r
|
||||
#proc r_get_next_job {iJob} {
|
||||
# puts [time { set res [r_get_next_job_r $iJob] }]
|
||||
# set res
|
||||
#puts [time { set res [r_get_next_job_r $iJob] }]
|
||||
#set res
|
||||
#}
|
||||
|
||||
# Usage:
|
||||
#
|
||||
# add_job OPTION ARG OPTION ARG...
|
||||
#
|
||||
# where available OPTIONS are:
|
||||
#
|
||||
# -displaytype
|
||||
# -displayname
|
||||
# -build
|
||||
# -dirname
|
||||
# -cmd
|
||||
# -depid
|
||||
# -copydir
|
||||
# -priority
|
||||
#
|
||||
# Returns the jobid value for the new job.
|
||||
#
|
||||
proc add_job {args} {
|
||||
|
||||
set options {
|
||||
-displaytype -displayname -build -dirname
|
||||
-cmd -depid -copydir -priority
|
||||
}
|
||||
|
||||
# Set default values of options.
|
||||
set A(-dirname) ""
|
||||
set A(-depid) ""
|
||||
set A(-copydir) ""
|
||||
set A(-priority) 0
|
||||
set A(-build) ""
|
||||
|
||||
array set A $args
|
||||
|
||||
# Check all required options are present. And that no extras are present.
|
||||
foreach o $options {
|
||||
if {[info exists A($o)]==0} { error "missing required option $o" }
|
||||
}
|
||||
foreach o [array names A] {
|
||||
if {[lsearch -exact $options $o]<0} { error "unrecognized option: $o" }
|
||||
}
|
||||
|
||||
set state ""
|
||||
if {$A(-depid)==""} { set state ready }
|
||||
|
||||
trdb eval {
|
||||
INSERT INTO jobs(
|
||||
displaytype, displayname, build, dirname, cmd, depid, copydir, priority,
|
||||
state
|
||||
) VALUES (
|
||||
$A(-displaytype),
|
||||
$A(-displayname),
|
||||
$A(-build),
|
||||
$A(-dirname),
|
||||
$A(-cmd),
|
||||
$A(-depid),
|
||||
$A(-copydir),
|
||||
$A(-priority),
|
||||
$state
|
||||
)
|
||||
}
|
||||
|
||||
trdb last_insert_rowid
|
||||
}
|
||||
|
||||
proc add_tcl_jobs {build config patternlist} {
|
||||
global TRG
|
||||
|
||||
set topdir [file dirname $::testdir]
|
||||
set testrunner_tcl [file normalize [info script]]
|
||||
|
||||
if {$build==""} {
|
||||
set testfixture [info nameofexec]
|
||||
} else {
|
||||
set testfixture [file join [lindex $build 1] $TRG(testfixture)]
|
||||
}
|
||||
|
||||
# The ::testspec array is populated by permutations.test
|
||||
foreach f [dict get $::testspec($config) -files] {
|
||||
|
||||
if {[llength $patternlist]>0} {
|
||||
set bMatch 0
|
||||
foreach p $patternlist {
|
||||
if {[string match $p [file tail $f]]} {
|
||||
set bMatch 1
|
||||
break
|
||||
}
|
||||
}
|
||||
if {$bMatch==0} continue
|
||||
}
|
||||
|
||||
if {[file pathtype $f]!="absolute"} { set f [file join $::testdir $f] }
|
||||
set f [file normalize $f]
|
||||
|
||||
set displayname [string map [list $topdir/ {}] $f]
|
||||
if {$config=="full" || $config=="veryquick"} {
|
||||
set cmd "$testfixture $f"
|
||||
} else {
|
||||
set cmd "$testfixture $testrunner_tcl $config $f"
|
||||
set displayname "config=$config $displayname"
|
||||
}
|
||||
if {$build!=""} {
|
||||
set displayname "[lindex $build 2] $displayname"
|
||||
}
|
||||
|
||||
set lProp [trd_test_script_properties $f]
|
||||
set priority 0
|
||||
if {[lsearch $lProp slow]>=0} { set priority 2 }
|
||||
if {[lsearch $lProp superslow]>=0} { set priority 4 }
|
||||
|
||||
add_job \
|
||||
-displaytype tcl \
|
||||
-displayname $displayname \
|
||||
-cmd $cmd \
|
||||
-depid [lindex $build 0] \
|
||||
-priority $priority
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
proc add_build_job {buildname target} {
|
||||
global TRG
|
||||
|
||||
set dirname "[string tolower [string map {- _} $buildname]]_$target"
|
||||
set dirname "testrunner_bld_$dirname"
|
||||
|
||||
set id [add_job \
|
||||
-displaytype bld \
|
||||
-displayname "Build $buildname ($target)" \
|
||||
-dirname $dirname \
|
||||
-build $buildname \
|
||||
-cmd "$TRG(makecmd) $target" \
|
||||
-priority 3
|
||||
]
|
||||
|
||||
list $id [file normalize $dirname] $buildname
|
||||
}
|
||||
|
||||
proc add_make_job {bld target} {
|
||||
global TRG
|
||||
|
||||
add_job \
|
||||
-displaytype make \
|
||||
-displayname "[lindex $bld 2] make $target" \
|
||||
-cmd "$TRG(makecmd) $target" \
|
||||
-copydir [lindex $bld 1] \
|
||||
-depid [lindex $bld 0] \
|
||||
-priority 1
|
||||
}
|
||||
|
||||
proc add_fuzztest_jobs {buildname} {
|
||||
|
||||
foreach {interpreter scripts} [trd_fuzztest_data] {
|
||||
set subcmd [lrange $interpreter 1 end]
|
||||
set interpreter [lindex $interpreter 0]
|
||||
|
||||
set bld [add_build_job $buildname $interpreter]
|
||||
foreach {depid dirname displayname} $bld {}
|
||||
|
||||
foreach s $scripts {
|
||||
|
||||
# Fuzz data files fuzzdata1.db and fuzzdata2.db are larger than
|
||||
# the others. So ensure that these are run as a higher priority.
|
||||
set tail [file tail $s]
|
||||
if {$tail=="fuzzdata1.db" || $tail=="fuzzdata2.db"} {
|
||||
set priority 5
|
||||
} else {
|
||||
set priority 1
|
||||
}
|
||||
|
||||
add_job \
|
||||
-displaytype fuzz \
|
||||
-displayname "$buildname $interpreter $tail" \
|
||||
-depid $depid \
|
||||
-cmd "[file join $dirname $interpreter] $subcmd $s" \
|
||||
-priority $priority
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
proc add_zipvfs_jobs {} {
|
||||
global TRG
|
||||
source [file join $TRG(zipvfs) test zipvfs_testrunner.tcl]
|
||||
|
||||
set bld [add_build_job Zipvfs $TRG(testfixture)]
|
||||
foreach s [zipvfs_testrunner_files] {
|
||||
set cmd "[file join [lindex $bld 1] $TRG(testfixture)] $s"
|
||||
add_job \
|
||||
-displaytype tcl \
|
||||
-displayname "Zipvfs [file tail $s]" \
|
||||
-cmd $cmd \
|
||||
-depid [lindex $bld 0]
|
||||
}
|
||||
|
||||
set ::env(SQLITE_TEST_DIR) $::testdir
|
||||
}
|
||||
|
||||
proc add_jobs_from_cmdline {patternlist} {
|
||||
global TRG
|
||||
|
||||
if {$TRG(zipvfs)!=""} {
|
||||
add_zipvfs_jobs
|
||||
if {[llength $patternlist]==0} return
|
||||
}
|
||||
|
||||
if {[llength $patternlist]==0} {
|
||||
set patternlist [list veryquick]
|
||||
}
|
||||
|
||||
set first [lindex $patternlist 0]
|
||||
switch -- $first {
|
||||
all {
|
||||
set patternlist [lrange $patternlist 1 end]
|
||||
set clist [trd_all_configs]
|
||||
foreach c $clist {
|
||||
add_tcl_jobs "" $c $patternlist
|
||||
}
|
||||
}
|
||||
|
||||
mdevtest {
|
||||
foreach b [list All-O0 All-Debug] {
|
||||
set bld [add_build_job $b $TRG(testfixture)]
|
||||
add_tcl_jobs $bld veryquick ""
|
||||
add_fuzztest_jobs $b
|
||||
}
|
||||
}
|
||||
|
||||
sdevtest {
|
||||
foreach b [list All-Sanitize All-Debug] {
|
||||
set bld [add_build_job $b $TRG(testfixture)]
|
||||
add_tcl_jobs $bld veryquick ""
|
||||
add_fuzztest_jobs $b
|
||||
}
|
||||
}
|
||||
|
||||
release {
|
||||
foreach b [trd_builds $TRG(platform)] {
|
||||
set bld [add_build_job $b $TRG(testfixture)]
|
||||
foreach c [trd_configs $TRG(platform) $b] {
|
||||
add_tcl_jobs $bld $c ""
|
||||
}
|
||||
|
||||
foreach e [trd_extras $TRG(platform) $b] {
|
||||
if {$e=="fuzztest"} {
|
||||
add_fuzztest_jobs $b
|
||||
} else {
|
||||
add_make_job $bld $e
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
default {
|
||||
if {[info exists ::testspec($first)]} {
|
||||
add_tcl_jobs "" $first [lrange $patternlist 1 end]
|
||||
} else {
|
||||
add_tcl_jobs "" full $patternlist
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
proc make_new_testset {} {
|
||||
global TRG
|
||||
|
||||
set tests [list]
|
||||
if {$TRG(zipvfs)!=""} {
|
||||
source [file join $TRG(zipvfs) test zipvfs_testrunner.tcl]
|
||||
lappend tests {*}[zipvfs_testrunner_testset]
|
||||
}
|
||||
|
||||
if {$tests=="" || $TRG(patternlist)!=""} {
|
||||
lappend tests {*}[testset_patternlist $TRG(patternlist)]
|
||||
}
|
||||
|
||||
r_write_db {
|
||||
|
||||
trdb eval $TRG(schema)
|
||||
set nJob $TRG(nJob)
|
||||
set cmdline $TRG(cmdline)
|
||||
@ -671,88 +792,44 @@ proc make_new_testset {} {
|
||||
trdb eval { REPLACE INTO config VALUES('cmdline', $cmdline ); }
|
||||
trdb eval { REPLACE INTO config VALUES('start', $tm ); }
|
||||
|
||||
foreach t $tests {
|
||||
foreach {b c s} $t {}
|
||||
set slow 0
|
||||
|
||||
if {$c!="make" && $c!="build"} {
|
||||
set fd [open $s]
|
||||
for {set ii 0} {$ii<100 && ![eof $fd]} {incr ii} {
|
||||
set line [gets $fd]
|
||||
if {[string match -nocase *testrunner:* $line]} {
|
||||
regexp -nocase {.*testrunner:(.*)} $line -> properties
|
||||
foreach p $properties {
|
||||
if {$p=="slow"} { set slow 1 }
|
||||
if {$p=="superslow"} { set slow 2 }
|
||||
}
|
||||
}
|
||||
}
|
||||
close $fd
|
||||
add_jobs_from_cmdline $TRG(patternlist)
|
||||
}
|
||||
|
||||
if {$c=="make" && $b==""} {
|
||||
# --fuzztest option
|
||||
set slow 1
|
||||
}
|
||||
|
||||
if {$c=="veryquick"} {
|
||||
set c ""
|
||||
}
|
||||
|
||||
set state ready
|
||||
if {$b!="" && $c!="build"} {
|
||||
set state ""
|
||||
}
|
||||
|
||||
set priority [expr {$slow*2}]
|
||||
if {$c=="make"} { incr priority 3 }
|
||||
if {$c=="build"} { incr priority 1 }
|
||||
|
||||
if {$c=="make" || $c=="build"} {
|
||||
set jobtype $c
|
||||
} else {
|
||||
set jobtype "script"
|
||||
}
|
||||
|
||||
trdb eval {
|
||||
INSERT INTO script
|
||||
(build, config, filename, slow, state, priority, jobtype)
|
||||
VALUES ($b, $c, $s, $slow, $state, $priority, $jobtype)
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
proc script_input_ready {fd iJob b c f} {
|
||||
proc script_input_ready {fd iJob jobid} {
|
||||
global TRG
|
||||
global O
|
||||
global T
|
||||
|
||||
if {[eof $fd]} {
|
||||
trdb eval { SELECT * FROM jobs WHERE jobid=$jobid } job {}
|
||||
|
||||
set ::done 1
|
||||
fconfigure $fd -blocking 1
|
||||
set state "done"
|
||||
set rc [catch { close $fd } msg]
|
||||
if {$rc} {
|
||||
puts "FAILED: $b $c $f"
|
||||
if {[info exists TRG(reportlength)]} {
|
||||
puts -nonewline "[string repeat " " $TRG(reportlength)]\r"
|
||||
}
|
||||
puts "FAILED: $job(displayname)"
|
||||
set state "failed"
|
||||
}
|
||||
|
||||
set tm [expr [clock_milliseconds] - $T($iJob)]
|
||||
set tm [clock_milliseconds]
|
||||
set jobtm [expr {$tm - $job(starttime)}]
|
||||
|
||||
puts $TRG(log) "### $b ### $c ### $f ${tm}ms ($state)"
|
||||
puts $TRG(log) "### $job(displayname) ${jobtm}ms ($state)"
|
||||
puts $TRG(log) [string trim $O($iJob)]
|
||||
|
||||
r_write_db {
|
||||
set output $O($iJob)
|
||||
trdb eval {
|
||||
UPDATE script SET output = $output, state=$state, time=$tm
|
||||
WHERE (build, config, filename) = ($b, $c, $f)
|
||||
}
|
||||
if {$state=="done" && $c=="build"} {
|
||||
trdb eval {
|
||||
UPDATE script SET state = 'ready' WHERE (build, state)==($b, '')
|
||||
}
|
||||
UPDATE jobs
|
||||
SET output=$output, state=$state, endtime=$tm
|
||||
WHERE jobid=$jobid;
|
||||
UPDATE jobs SET state='ready' WHERE depid=$jobid;
|
||||
}
|
||||
}
|
||||
|
||||
@ -783,79 +860,43 @@ proc launch_another_job {iJob} {
|
||||
set testfixture [info nameofexec]
|
||||
set script $TRG(info_script)
|
||||
|
||||
set dir [dirname $iJob]
|
||||
create_or_clear_dir $dir
|
||||
|
||||
set O($iJob) ""
|
||||
|
||||
set job [r_get_next_job $iJob]
|
||||
if {$job==""} { return 0 }
|
||||
set jobdict [r_get_next_job $iJob]
|
||||
if {$jobdict==""} { return 0 }
|
||||
array set job $jobdict
|
||||
|
||||
foreach {b c f} $job {}
|
||||
set dir $job(dirname)
|
||||
if {$dir==""} { set dir [dirname $iJob] }
|
||||
create_or_clear_dir $dir
|
||||
|
||||
if {$c=="build"} {
|
||||
set testdir [file dirname $TRG(info_script)]
|
||||
set srcdir [file dirname $testdir]
|
||||
set builddir [build_to_dirname $b]
|
||||
create_or_clear_dir $builddir
|
||||
|
||||
if {$b=="Zipvfs"} {
|
||||
if {$job(build)!=""} {
|
||||
set srcdir [file dirname $::testdir]
|
||||
if {$job(build)=="Zipvfs"} {
|
||||
set script [zipvfs_testrunner_script]
|
||||
} else {
|
||||
set script [trd_buildscript $b $srcdir [expr {$TRG(platform)=="win"}]]
|
||||
set bWin [expr {$TRG(platform)=="win"}]
|
||||
set script [trd_buildscript $job(build) $srcdir $bWin]
|
||||
}
|
||||
|
||||
set fd [open [file join $builddir $TRG(make)] w]
|
||||
set fd [open [file join $dir $TRG(make)] w]
|
||||
puts $fd $script
|
||||
close $fd
|
||||
|
||||
puts "Launching build \"$b\" in directory $builddir..."
|
||||
set target coretestprogs
|
||||
if {$b=="User-Auth"} { set target testfixture }
|
||||
|
||||
set cmd "$TRG(makecmd) $target"
|
||||
set dir $builddir
|
||||
|
||||
} elseif {$c=="make"} {
|
||||
if {$b==""} {
|
||||
if {$f!="fuzztest"} { error "corruption in testrunner.db!" }
|
||||
# Special case - run [make fuzztest]
|
||||
set makedir [file dirname $testfixture]
|
||||
if {$TRG(platform)=="win"} {
|
||||
error "how?"
|
||||
} else {
|
||||
set cmd [list make -C $makedir fuzztest]
|
||||
}
|
||||
} else {
|
||||
set builddir [build_to_dirname $b]
|
||||
copy_dir $builddir $dir
|
||||
set cmd "$TRG(makecmd) $f"
|
||||
}
|
||||
} else {
|
||||
if {$b==""} {
|
||||
set testfixture [info nameofexec]
|
||||
} else {
|
||||
set tail testfixture
|
||||
if {$TRG(platform)=="win"} { set tail testfixture.exe }
|
||||
set testfixture [file normalize [file join [build_to_dirname $b] $tail]]
|
||||
}
|
||||
|
||||
if {$c=="valgrind"} {
|
||||
set testfixture "valgrind -v --error-exitcode=1 $testfixture"
|
||||
set ::env(OMIT_MISUSE) 1
|
||||
if {$job(copydir)!=""} {
|
||||
foreach f [glob -nocomplain [file join $job(copydir) *]] {
|
||||
catch { file copy -force $f $dir }
|
||||
}
|
||||
set cmd [concat $testfixture [list $script $c $f]]
|
||||
}
|
||||
|
||||
set pwd [pwd]
|
||||
cd $dir
|
||||
set fd [open "|$cmd 2>@1" r]
|
||||
set fd [open "|$job(cmd) 2>@1" r]
|
||||
cd $pwd
|
||||
set pid [pid $fd]
|
||||
|
||||
fconfigure $fd -blocking false
|
||||
fileevent $fd readable [list script_input_ready $fd $iJob $b $c $f]
|
||||
unset -nocomplain ::env(OMIT_MISUSE)
|
||||
fileevent $fd readable [list script_input_ready $fd $iJob $job(jobid)]
|
||||
|
||||
return 1
|
||||
}
|
||||
@ -866,29 +907,20 @@ proc one_line_report {} {
|
||||
set tm [expr [clock_milliseconds] - $TRG(starttime)]
|
||||
set tm [format "%d" [expr int($tm/1000.0 + 0.5)]]
|
||||
|
||||
foreach s {ready running done failed} {
|
||||
set v($s,build) 0
|
||||
set v($s,make) 0
|
||||
set v($s,script) 0
|
||||
}
|
||||
|
||||
r_write_db {
|
||||
trdb eval {
|
||||
SELECT state, jobtype, count(*) AS cnt
|
||||
FROM script
|
||||
GROUP BY state, jobtype
|
||||
SELECT displaytype, state, count(*) AS cnt
|
||||
FROM jobs
|
||||
GROUP BY 1, 2
|
||||
} {
|
||||
set v($state,$jobtype) $cnt
|
||||
if {[info exists t($jobtype)]} {
|
||||
incr t($jobtype) $cnt
|
||||
} else {
|
||||
set t($jobtype) $cnt
|
||||
}
|
||||
set v($state,$displaytype) $cnt
|
||||
incr t($displaytype) $cnt
|
||||
}
|
||||
}
|
||||
|
||||
set text ""
|
||||
foreach j [array names t] {
|
||||
foreach j [lsort [array names t]] {
|
||||
foreach k {done failed running} { incr v($k,$j) 0 }
|
||||
set fin [expr $v(done,$j) + $v(failed,$j)]
|
||||
lappend text "$j ($fin/$t($j)) f=$v(failed,$j) r=$v(running,$j)"
|
||||
}
|
||||
@ -898,7 +930,7 @@ proc one_line_report {} {
|
||||
}
|
||||
set report "${tm}s: [join $text { }]"
|
||||
set TRG(reportlength) [string length $report]
|
||||
if {[string length $report]<80} {
|
||||
if {[string length $report]<100} {
|
||||
puts -nonewline "$report\r"
|
||||
flush stdout
|
||||
} else {
|
||||
@ -910,9 +942,8 @@ proc one_line_report {} {
|
||||
|
||||
proc launch_some_jobs {} {
|
||||
global TRG
|
||||
r_write_db {
|
||||
set nJob [trdb one { SELECT value FROM config WHERE name='njob' }]
|
||||
}
|
||||
|
||||
while {[dirs_nHelper]<$nJob} {
|
||||
set iDir [dirs_allocDir]
|
||||
if {0==[launch_another_job $iDir]} {
|
||||
@ -930,7 +961,6 @@ proc run_testset {} {
|
||||
set TRG(log) [open $TRG(logname) w]
|
||||
|
||||
launch_some_jobs
|
||||
# launch_another_job $ii
|
||||
|
||||
one_line_report
|
||||
while {[dirs_nHelper]>0} {
|
||||
@ -943,13 +973,13 @@ proc run_testset {} {
|
||||
r_write_db {
|
||||
set tm [clock_milliseconds]
|
||||
trdb eval { REPLACE INTO config VALUES('end', $tm ); }
|
||||
set nErr [trdb one {SELECT count(*) FROM script WHERE state='failed'}]
|
||||
set nErr [trdb one {SELECT count(*) FROM jobs WHERE state='failed'}]
|
||||
if {$nErr>0} {
|
||||
puts "$nErr failures:"
|
||||
trdb eval {
|
||||
SELECT build, config, filename FROM script WHERE state='failed'
|
||||
SELECT displayname FROM jobs WHERE state='failed'
|
||||
} {
|
||||
puts "FAILED: $build $config $filename"
|
||||
puts "FAILED: $displayname"
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@ -370,15 +370,45 @@ proc trd_configs {platform bld} {
|
||||
|
||||
proc trd_extras {platform bld} {
|
||||
trd_import
|
||||
if {[info exists extra($platform.$bld)]==0} { return [list] }
|
||||
return $extra($platform.$bld)
|
||||
}
|
||||
|
||||
set elist [list]
|
||||
if {[info exists extra($platform.$bld)]} {
|
||||
set elist $extra($platform.$bld)
|
||||
# Usage:
|
||||
#
|
||||
# trd_fuzztest_data
|
||||
#
|
||||
# This returns data used by testrunner.tcl to run commands equivalent
|
||||
# to [make fuzztest]. The returned value is a list, which should be
|
||||
# interpreted as a sequence of pairs. The first element of each pair
|
||||
# is an interpreter name. The second element is a list of files.
|
||||
# testrunner.tcl automatically creates one job to build each interpreter,
|
||||
# and one to run each of the files with it once it has been built.
|
||||
#
|
||||
# In practice, the returned value looks like this:
|
||||
#
|
||||
# {
|
||||
# {fuzzcheck {$testdir/fuzzdata1.db $testdir/fuzzdata2.db ...}}
|
||||
# {{sessionfuzz run} $testdir/sessionfuzz-data1.db}
|
||||
# }
|
||||
#
|
||||
# where $testdir is replaced by the full-path to the test-directory (the
|
||||
# directory containing this file). "fuzzcheck" and "sessionfuzz" have .exe
|
||||
# extensions on windows.
|
||||
#
|
||||
proc trd_fuzztest_data {} {
|
||||
set EXE ""
|
||||
if {$::tcl_platform(platform)=="windows"} {
|
||||
set EXE ".exe"
|
||||
}
|
||||
|
||||
set elist
|
||||
set lFuzzDb [glob [file join $::testdir fuzzdata*.db]]
|
||||
set lSessionDb [glob [file join $::testdir sessionfuzz-data*.db]]
|
||||
|
||||
return [list fuzzcheck$EXE $lFuzzDb "sessionfuzz$EXE run" $lSessionDb]
|
||||
}
|
||||
|
||||
|
||||
proc trd_all_configs {} {
|
||||
trd_import
|
||||
set all_configs
|
||||
@ -394,7 +424,7 @@ proc make_sh_script {srcdir opts cflags makeOpts configOpts} {
|
||||
set myopts ""
|
||||
if {[info exists ::env(OPTS)]} {
|
||||
append myopts "# From environment variable:\n"
|
||||
append myopts "OPTS=$::env(OPTS)\n"
|
||||
append myopts "OPTS=$::env(OPTS)\n\n"
|
||||
}
|
||||
foreach o [lsort $opts] {
|
||||
append myopts "OPTS=\"\$OPTS $o\"\n"
|
||||
@ -560,4 +590,36 @@ proc trd_buildscript {config srcdir bMsvc} {
|
||||
return [make_script $build($config) $srcdir $bMsvc]
|
||||
}
|
||||
|
||||
# Usage:
|
||||
#
|
||||
# trd_test_script_properties PATH
|
||||
#
|
||||
# The argument must be a path to a Tcl test script. This function scans the
|
||||
# first 100 lines of the script for lines that look like:
|
||||
#
|
||||
# TESTRUNNER: <properties>
|
||||
#
|
||||
# where <properties> is a list of identifiers, each of which defines a
|
||||
# property of the test script. Example properties are "slow" or "superslow".
|
||||
#
|
||||
proc trd_test_script_properties {path} {
|
||||
# Use this global array as a cache:
|
||||
global trd_test_script_properties_cache
|
||||
|
||||
if {![info exists trd_test_script_properties_cache($path)]} {
|
||||
set fd [open $path]
|
||||
set ret [list]
|
||||
for {set line 0} {$line < 100 && ![eof $fd]} {incr line} {
|
||||
set text [gets $fd]
|
||||
if {[string match -nocase *testrunner:* $text]} {
|
||||
regexp -nocase {.*testrunner:(.*)} $text -> properties
|
||||
lappend ret {*}$properties
|
||||
}
|
||||
}
|
||||
set trd_test_script_properties_cache($path) $ret
|
||||
close $fd
|
||||
}
|
||||
|
||||
set trd_test_script_properties_cache($path)
|
||||
}
|
||||
|
||||
|
||||
Reference in New Issue
Block a user