2 # Script to runs tests for SQLite. Run with option "help" for more info. \
6 set testdir
[file normalize
[file dirname $argv0]]
9 source [file join $testdir testrunner_data.tcl
]
10 source [file join $testdir permutations.
test]
14 # This script requires an interpreter that supports [package require sqlite3]
15 # to run. If this is not such an intepreter, see if there is a [testfixture]
16 # in the current directory. If so, run the command using it. If not,
17 # recommend that the user build one.
19 proc find_interpreter
{} {
21 set interpreter
[file tail [info nameofexec
]]
22 set rc
[catch
{ package require sqlite3
}]
24 if {[file readable pkgIndex.tcl
] && [catch
{source pkgIndex.tcl
}]==0} {
25 set rc
[catch
{ package require sqlite3
}]
29 if { [string match
-nocase testfixture
* $interpreter]==0
30 && [file executable .
/testfixture
]
32 puts
"Failed to find tcl package sqlite3. Restarting with ./testfixture.."
34 exec .
/testfixture
[info
script] {*}$
::argv
>@ stdout
40 puts
"Cannot find tcl package sqlite3: Trying to build it now..."
41 if {$
::tcl_platform
(platform
)=="windows"} {
42 set bat
[open make-tcl-extension.bat w
]
43 puts
$bat "nmake /f Makefile.msc tclextension"
45 catch
{exec -ignorestderr -- make-tcl-extension.bat
}
47 catch
{exec make tclextension
}
49 if {[file readable pkgIndex.tcl
] && [catch
{source pkgIndex.tcl
}]==0} {
50 set rc
[catch
{ package require sqlite3
}]
53 puts
"The SQLite tcl extension was successfully built and loaded."
54 puts
"Run \"make tclextension-install\" to avoid having to rebuild\
57 puts
"Unable to build the SQLite tcl extension"
61 puts stderr
"Cannot find a working instance of the SQLite tcl extension."
62 puts stderr
"Run \"make tclextension\" or \"make testfixture\" and\
69 # Usually this script is run by [testfixture]. But it can also be run
70 # by a regular [tclsh]. For these cases, emulate the [clock_milliseconds]
72 if {[info commands clock_milliseconds
]==""} {
73 proc clock_milliseconds
{} {
78 #-------------------------------------------------------------------------
82 set a0
[file tail $
::argv0
]
84 puts stderr
[string trim
[subst
-nocommands {
86 $a0 ?SWITCHES? ?PERMUTATION? ?PATTERNS?
88 $a0 errors ?
-v|
--verbose? ?
-s|
--summary? ?PATTERN?
92 $a0 script ?
-msvc? CONFIG
93 $a0 status ?
-d SECS? ?
--cls?
96 --buildonly Build
test exes but
do not run tests
97 --config CONFIGS Only use configs on comma-separate list CONFIGS
98 --dryrun Write what would have happened to testrunner.log
99 --explain Write summary to stdout
100 --jobs NUM Run tests using NUM separate processes
101 --omit CONFIGS Omit configs on comma-separated list CONFIGS
102 --status Show the full
"status" report
while running
103 --stop-on-coredump Stop running
if any
test segfaults
104 --stop-on-error Stop running after any reported error
105 --zipvfs ZIPVFSDIR ZIPVFS
source directory
107 Special values
for PERMUTATION that work with plain tclsh
:
109 list
- show all allowed PERMUTATION arguments.
110 mdevtest
- tests recommended prior to normal development check-ins.
111 release
- full release
test with various builds.
112 sdevtest
- like mdevtest but using ASAN and UBSAN.
114 Other PERMUTATION arguments must be run using testfixture
, not tclsh
:
116 all
- all tcl
test scripts
, plus a subset of
test scripts rerun
117 with various permutations.
118 full
- all tcl
test scripts.
119 veryquick
- a fast subset of the tcl
test scripts. This is the default.
121 If no PATTERN arguments are present
, all tests specified by the PERMUTATION
122 are run. Otherwise
, each pattern is interpreted as a glob pattern. Only
123 those tcl tests
for which the final component of the filename matches
at
124 least one specified pattern are run. The glob wildcard
'*' is prepended
125 to the pattern
if it does not start with
'^' and appended to every
126 pattern that does not end with
'$'.
128 If no PATTERN arguments are present
, then various fuzztest
, threadtest
129 and other tests are run as part of the
"release" permutation. These are
130 omitted
if any PATTERN arguments are specified on the
command line.
132 If a PERMUTATION is specified and is followed by the path to a Tcl
script
133 instead of a list of patterns
, then that single Tcl
test script is run
134 with the specified permutation.
136 The
"status" and
"njob" commands are designed to be run from the same
137 directory as a running testrunner.tcl
script that is running tests. The
138 "status" command prints a report describing the current state and progress
139 of the tests. Use the
"-d N" option to have the status display
clear the
140 screen and repeat every N seconds. The
"njob" command may be used to query
141 or modify the number of sub-processes the
test script uses to run tests.
143 The
"script" command outputs the
script used to build a configuration.
144 Add the
"-msvc" option
for a Windows-compatible
script. For a list of
145 available configurations enter
"$a0 script help".
147 The
"errors" commands shows the output of tests that failed
in the
148 most recent run. Complete output is shown
if the
-v or
--verbose options
149 are used. Otherwise
, an attempt is made to minimize the output to show
150 only the parts that contain the error messages. The
--summary option just
151 shows the
jobs that failed. If PATTERN are provided
, the error information
152 is only provided
for jobs that match PATTERN.
154 Full documentation here
: https
://sqlite.org
/src
/doc
/trunk
/doc
/testrunner.md
159 #-------------------------------------------------------------------------
161 #-------------------------------------------------------------------------
162 # Try to estimate a the number of processes to use.
164 # Command [guess_number_of_cores] attempts to glean the number of logical
165 # cores. Command [default_njob] returns the default value for the --jobs
168 proc guess_number_of_cores
{} {
169 if {[catch
{number_of_cores
} ret
]} {
172 if {$
::tcl_platform
(platform
)=="windows"} {
173 catch
{ set ret $
::env
(NUMBER_OF_PROCESSORS
) }
175 if {$
::tcl_platform
(os
)=="Darwin"} {
176 set cmd
"sysctl -n hw.logicalcpu"
181 set fd
[open
"|$cmd" r
]
191 proc default_njob
{} {
193 if {[info exists env
(NJOB
)] && $env(NJOB
)>=1} {
196 set nCore
[guess_number_of_cores
]
200 set nHelper
[expr int
($nCore*0.5)]
204 #-------------------------------------------------------------------------
206 #-------------------------------------------------------------------------
207 # Setup various default values in the global TRG() array.
209 set TRG
(dbname
) [file normalize testrunner.db
]
210 set TRG
(logname
) [file normalize testrunner.log
]
211 set TRG
(build.logname
) [file normalize testrunner_build.log
]
212 set TRG
(info_script
) [file normalize
[info
script]]
213 set TRG
(timeout
) 10000 ;# Default busy-timeout for testrunner.db
214 set TRG
(nJob
) [default_njob
] ;# Default number of helper processes
215 set TRG
(patternlist
) [list
]
216 set TRG
(cmdline
) $argv
217 set TRG
(reporttime
) 2000
218 set TRG
(fuzztest
) 0 ;# is the fuzztest option present.
219 set TRG
(zipvfs
) "" ;# -zipvfs option, if any
220 set TRG
(buildonly
) 0 ;# True if --buildonly option
221 set TRG
(config
) {} ;# Only build the named configurations
222 set TRG
(omitconfig
) {} ;# Do not build these configurations
223 set TRG
(dryrun
) 0 ;# True if --dryrun option
224 set TRG
(explain
) 0 ;# True for the --explain option
225 set TRG
(stopOnError
) 0 ;# Stop running at first failure
226 set TRG
(stopOnCore
) 0 ;# Stop on a core-dump
227 set TRG
(fullstatus
) 0 ;# Full "status" report while running
229 switch
-nocase -glob -- $tcl_platform(os
) {
231 set TRG
(platform
) osx
232 set TRG
(make) make.sh
233 set TRG
(makecmd
) "bash make.sh"
234 set TRG
(testfixture
) testfixture
235 set TRG
(shell
) sqlite3
237 set TRG
(runcmd
) "bash run.sh"
240 set TRG
(platform
) linux
241 set TRG
(make) make.sh
242 set TRG
(makecmd
) "bash make.sh"
243 set TRG
(testfixture
) testfixture
244 set TRG
(shell
) sqlite3
246 set TRG
(runcmd
) "bash run.sh"
249 set TRG
(platform
) win
250 set TRG
(make) make.bat
251 set TRG
(makecmd
) "call make.bat"
252 set TRG
(testfixture
) testfixture.exe
253 set TRG
(shell
) sqlite3.exe
255 set TRG
(runcmd
) "run.bat"
258 error
"cannot determine platform!"
261 #-------------------------------------------------------------------------
263 #-------------------------------------------------------------------------
264 # The database schema used by the testrunner.db database.
267 DROP TABLE IF EXISTS
jobs;
268 DROP TABLE IF EXISTS config
;
271 ** This table contains one row
for each job that testrunner.tcl must run
272 ** before the entire
test run is finished.
275 ** Unique identifier
for each job. Must be a
+ve non-zero number.
278 ** 3 or
4 letter mnemonic
for the class of tests this belongs to e.g.
279 ** "fuzz", "tcl", "make" etc.
282 ** Name
/description of job. For display purposes.
285 ** If the job requires a
make.bat
/make.sh
make wrapper
(i.e. to build
286 ** something
), the name of the build configuration it uses. See
287 ** testrunner_data.tcl
for a list of build configs. e.g.
"Win32-MemDebug".
290 ** If the job should use a well-known directory name
for its
291 ** sub-directory instead of an anonymous
"testdir[1234...]" sub-dir
292 ** that is deleted after the job is finished.
295 ** Bash or
batch script to run the job.
298 ** The jobid value of a job that this job depends on. This job may not
299 ** be run before its depid job has finished successfully.
302 ** Higher values run first. Sometimes.
305 /* Fields populated when db is initialized
*/
306 jobid INTEGER PRIMARY KEY
, -- id to identify job
307 displaytype TEXT NOT NULL
, -- Type of
test (for one line report
)
308 displayname TEXT NOT NULL
, -- Human readable job name
309 build TEXT NOT NULL DEFAULT
'', -- make.sh
/make.bat
file request
, if any
310 dirname TEXT NOT NULL DEFAULT
'', -- directory name
, if required
311 cmd TEXT NOT NULL
, -- shell
command to run
312 depid INTEGER
, -- identifier of dependency
(or
'')
313 priority INTEGER NOT NULL
, -- higher priority
jobs may run earlier
315 /* Fields updated as
jobs run
*/
316 starttime INTEGER
, -- Start
time (milliseconds since
1970)
317 endtime INTEGER
, -- End
time
318 state TEXT CHECK
( state IN
('','ready','running','done','failed','omit') ),
319 ntest INT
, -- Number of
test cases run
320 nerr INT
, -- Number of errors reported
321 svers TEXT
, -- Reported SQLite version
322 pltfm TEXT
, -- Host platform reported
323 output TEXT
-- test output
327 name TEXT COLLATE nocase PRIMARY KEY
,
331 CREATE INDEX i1 ON
jobs(state
, priority
);
332 CREATE INDEX i2 ON
jobs(depid
);
334 #-------------------------------------------------------------------------
336 #--------------------------------------------------------------------------
337 # Check if this script is being invoked to run a single file. If so,
340 if {[llength
$argv]==2
341 && ([lindex
$argv 0]=="" ||
[info exists
::testspec
([lindex
$argv 0])])
342 && [file exists
[lindex
$argv 1]]
344 set permutation
[lindex
$argv 0]
345 set script [file normalize
[lindex
$argv 1]]
348 set testdir
[file dirname $argv0]
349 source $
::testdir
/tester.tcl
351 if {$permutation=="full"} {
353 unset -nocomplain ::G
(isquick
)
356 } elseif
{$permutation!="default" && $permutation!=""} {
358 if {[info exists
::testspec
($permutation)]==0} {
359 error
"no such permutation: $permutation"
362 array
set O $
::testspec
($permutation)
363 set ::G
(perm
:name
) $permutation
364 set ::G
(perm
:prefix
) $O(-prefix)
366 set ::G
(perm
:dbconfig
) $O(-dbconfig)
367 set ::G
(perm
:presql
) $O(-presql)
369 rename finish_test helper_finish_test
370 proc finish_test
{} "
384 #--------------------------------------------------------------------------
386 #--------------------------------------------------------------------------
387 # Check if this is the "njob" command:
389 if {([llength
$argv]==2 ||
[llength
$argv]==1)
390 && [string compare
-nocase njob
[lindex
$argv 0]]==0
392 sqlite3 mydb
$TRG(dbname
)
393 if {[llength
$argv]==2} {
394 set param
[lindex
$argv 1]
395 if {[string is integer
$param]==0 ||
$param<0 ||
$param>128} {
396 puts stderr
"parameter must be an integer between 0 and 128"
400 mydb
eval { REPLACE INTO config VALUES
('njob', $param); }
402 set res
[mydb one
{ SELECT value FROM config WHERE name
='njob' }]
407 #--------------------------------------------------------------------------
409 #--------------------------------------------------------------------------
410 # Check if this is the "help" command:
412 if {[string compare
-nocase help [lindex
$argv 0]]==0} {
415 #--------------------------------------------------------------------------
417 #--------------------------------------------------------------------------
418 # Check if this is the "script" command:
420 if {[string compare
-nocase script [lindex
$argv 0]]==0} {
421 if {[llength
$argv]!=2 && !([llength
$argv]==3&&[lindex
$argv 1]=="-msvc")} {
425 set bMsvc
[expr ([llength
$argv]==3)]
426 set config
[lindex
$argv [expr [llength
$argv]-1]]
428 puts
[trd_buildscript
$config [file dirname $testdir] $bMsvc]
432 # Compute an elapse time string MM:SS or HH:MM:SS based on the
433 # number of milliseconds in the argument.
435 proc elapsetime
{ms
} {
436 set s
[expr {int
(($ms+500.0)*0.001)}]
437 set hr
[expr {$s/3600}]
438 set mn
[expr {($s/60)%60}]
439 set sc
[expr {$s%60}]
441 return [format
%02d
:%02d
:%02d
$hr $mn $sc]
443 return [format
%02d
:%02d
$mn $sc]
447 # Helper routine for show_status
449 proc display_job
{jobdict
{tm
""}} {
450 array
set job
$jobdict
451 if {[string length
$job(displayname
)]>65} {
452 set dfname
[format
%.65s...
$job(displayname
)]
454 set dfname
[format
%-68s $job(displayname
)]
458 set dtm
[expr {$tm-$job(starttime
)}]
459 set dtm
[format
%8s
[elapsetime
$dtm]]
461 set dtm
[format
%8s
""]
466 # This procedure shows the "status" page. It uses the database
467 # connect passed in as the "db" parameter. If the "cls" parameter
468 # is true, then VT100 escape codes are used to format the display.
470 proc show_status
{db cls
} {
474 set cmdline
[$db one
{ SELECT value FROM config WHERE name
='cmdline' }]
475 set nJob
[$db one
{ SELECT value FROM config WHERE name
='njob' }]
477 if {$cls} {puts
"\033\[H\033\[2J"}
478 puts
"Cannot read database: $TRG(dbname)"
481 set now
[clock_milliseconds
]
484 COALESCE
((SELECT value FROM config WHERE name
='end'), $now) -
485 (SELECT value FROM config WHERE name
='start')
489 foreach s
{"" ready running
done failed
} { set S
($s) 0 }
491 SELECT state
, count
(*) AS cnt FROM
jobs GROUP BY
1
499 SELECT
sum(ntest
) AS nt
, sum(nerr
) AS ne FROM
jobs HAVING nt
>0
501 set fin
[expr $S(done)+$S(failed
)]
502 if {$cmdline!=""} {set cmdline
" $cmdline"}
505 # Move the cursor to the top-left corner. Each iteration will simply
507 puts
-nonewline "\033\[H"
510 puts
[format
%-79.79s
"Command: \[testrunner.tcl$cmdline\]"]
511 puts
[format
%-79.79s
"Summary: [elapsetime $tm], $fin/$total jobs,\
512 $ne errors, $nt tests"]
514 set srcdir
[file dirname [file dirname $TRG(info_script
)]]
515 set line
"Running: $S(running) (max: $nJob)"
516 if {$S(running
)>0 && $fin>100 && $fin>0.05*$total} {
517 # Only estimate the time remaining after completing at least 100
518 # jobs amounting to 10% of the total. Never estimate less than
519 # 2% of the total time used so far.
520 set tmleft
[expr {($tm/$fin)*($total-$fin)}]
521 if {$tmleft<0.02*$tm} {
522 set tmleft
[expr {$tm*0.02}]
524 append line
" est time left [elapsetime $tmleft]"
526 puts
[format
%-79.79s
$line]
529 SELECT
* FROM
jobs WHERE state
='running' ORDER BY starttime
531 display_job
[array get job
] $now
535 # $toshow is the number of failures to report. In $cls mode,
536 # status tries to limit the number of failure reported so that
537 # the status display does not overflow a 24-line terminal. It will
538 # always show at least the most recent 4 failures, even if an overflow
539 # is needed. No limit is imposed for a status within $cls.
541 if {$cls && $S(failed
)>18-$S(running
)} {
542 set toshow
[expr {18-$S(running
)}]
543 if {$toshow<4} {set toshow
4}
544 set shown
" (must recent $toshow shown)"
546 set toshow
$S(failed
)
549 puts
[format
%-79s "Failed: $S(failed) $shown"]
551 SELECT
* FROM
jobs WHERE state
='failed'
552 ORDER BY endtime DESC LIMIT
$toshow
554 display_job
[array get job
]
556 set nOmit
[$db one
{SELECT count
(*) FROM
jobs WHERE state
='omit'}]
558 puts
[format
%-79s " ... $nOmit jobs omitted due to failures"]
562 # Clear everything else to the bottom of the screen
563 puts
-nonewline "\033\[0J"
571 #--------------------------------------------------------------------------
572 # Check if this is the "status" command:
574 if {[llength
$argv]>=1
575 && [string compare
-nocase status
[lindex
$argv 0]]==0
579 for {set ii
1} {$ii<[llength
$argv]} {incr ii
} {
580 set a0
[lindex
$argv $ii]
581 if {$a0=="-d" && $ii+1<[llength
$argv]} {
583 set delay
[lindex
$argv $ii]
584 if {![string is integer
-strict $delay]} {
585 puts
"Argument to -d should be an integer"
588 } elseif
{$a0=="-cls" ||
$a0=="--cls"} {
591 puts
"unknown option: \"$a0\""
596 if {![file readable
$TRG(dbname
)]} {
597 puts
"Database missing: $TRG(dbname)"
600 sqlite3 mydb
$TRG(dbname
)
603 # Clear the whole screen initially.
605 if {$delay>0 ||
$cls} {puts
-nonewline "\033\[2J"}
608 show_status mydb
[expr {$delay>0 ||
$cls}]
610 after
[expr {$delay*1000}]
616 #--------------------------------------------------------------------------
617 # Check if this is the "joblist" command:
619 if {[llength
$argv]>=1
620 && [string compare
-nocase "joblist" [lindex
$argv 0]]==0
623 for {set ii
1} {$ii<[llength
$argv]} {incr ii
} {
624 set a0
[lindex
$argv $ii]
626 set pattern
[string trim
$a0 *]
628 puts
"unknown option: \"$a0\""
632 set SQL
{SELECT displaytype
, displayname
, state FROM
jobs}
634 regsub
-all {[^a-zA-Z0-9
*.
-/]} $pattern ? pattern
635 append SQL
" WHERE displayname GLOB '*$pattern*'"
637 append SQL
" ORDER BY starttime"
639 if {![file readable
$TRG(dbname
)]} {
640 puts
"Database missing: $TRG(dbname)"
643 sqlite3 mydb
$TRG(dbname
)
649 ready
{set label READY
}
650 done {set label DONE
}
651 failed
{set label FAILED
}
652 omit
{set label OMIT
}
653 running
{set label RUNNING
}
655 puts
[format
{%-7s %-5s %s
} $label $displaytype $displayname]
661 # Scan the output of all jobs looking for the summary lines that
662 # report the number of test cases and the number of errors.
663 # Aggregate these numbers and return them.
665 proc aggregate_test_counts
{db
} {
668 $db eval {SELECT
sum(nerr
) AS ne
, sum(ntest
) as nt FROM
jobs} break
669 return [list
$ne $nt]
672 #--------------------------------------------------------------------------
673 # Check if this is the "errors" command:
675 if {[llength
$argv]>=1
676 && ([string compare
-nocase errors
[lindex
$argv 0]]==0 ||
677 [string match err
* [lindex
$argv 0]]==1)
682 for {set ii
1} {$ii<[llength
$argv]} {incr ii
} {
683 set a0
[lindex
$argv $ii]
684 if {$a0=="-v" ||
$a0=="--verbose" ||
$a0=="-verbose"} {
686 } elseif
{$a0=="-s" ||
$a0=="--summary" ||
$a0=="-summary"} {
688 } elseif
{$pattern==""} {
689 set pattern
*[string trim
$a0 *]*
691 puts
"unknown option: \"$a0\"". Use
--help for more info.
"
696 sqlite3 mydb $TRG(dbname)
699 set sql "SELECT displayname FROM
jobs WHERE state
='failed'"
701 set sql "SELECT displaytype
, displayname
, output FROM
jobs \
702 WHERE state
='failed'"
705 regsub -all {[^a-zA-Z0-9*/ ?]} $pattern . pattern
706 append sql " AND displayname GLOB
'$pattern'"
710 puts "FAILED
: $displayname"
713 puts "**** $displayname ****"
714 if {$verbose || $displaytype!="tcl
"} {
717 foreach line [split $output \n] {
718 if {[string match {!*} $line] || [string match *failed* $line]} {
726 set summary [aggregate_test_counts mydb]
728 puts "Total
[lindex
$summary 0] errors out of
[lindex
$summary 1] tests
"
735 #-------------------------------------------------------------------------
736 # Parse the command line.
738 for {set ii 0} {$ii < [llength $argv]} {incr ii} {
739 set isLast [expr $ii==([llength $argv]-1)]
740 set a [lindex $argv $ii]
741 set n [string length $a]
743 if {[string range $a 0 0]=="-"} {
744 if {($n>2 && [string match "$a*" --jobs]) || $a=="-j"} {
746 set TRG(nJob) [lindex $argv $ii]
747 if {$isLast} { usage }
748 } elseif {($n>2 && [string match "$a*" --zipvfs]) || $a=="-z"} {
750 set TRG(zipvfs) [file normalize [lindex $argv $ii]]
751 if {$isLast} { usage }
752 } elseif {($n>2 && [string match "$a*" --buildonly]) || $a=="-b"} {
754 } elseif {($n>2 && [string match "$a*" --config]) || $a=="-c"} {
756 set TRG(config) [lindex $argv $ii]
757 } elseif {($n>2 && [string match "$a*" --dryrun]) || $a=="-d"} {
759 } elseif {($n>2 && [string match "$a*" --explain]) || $a=="-e"} {
761 } elseif {($n>2 && [string match "$a*" --omit]) || $a=="-c"} {
763 set TRG(omitconfig) [lindex $argv $ii]
764 } elseif {[string match "$a*" --stop-on-error]} {
765 set TRG(stopOnError) 1
766 } elseif {[string match "$a*" --stop-on-coredump]} {
767 set TRG(stopOnCore) 1
768 } elseif {[string match "$a*" --status]} {
769 if {$tcl_platform(platform)=="windows
"} {
771 "The
--status option is not available on Windows. A suggested work-around
"
773 "is to run the following
command in a separate window
:\n"
774 puts stdout " [info nameofexe
] $argv0 status
-d 2\n"
776 set TRG(fullstatus) 1
782 lappend TRG(patternlist) [string map {% *} $a]
787 # This script runs individual tests - tcl scripts or [make xyz] commands -
788 # in directories named "testdir
$N", where $N is an integer. This variable
789 # contains a list of integers indicating the directories in use.
791 # This variable is accessed only via the following commands:
794 # Return the number of entries currently in the list.
797 # Remove value IDIR from the list. It is an error if it is not present.
800 # Select a value that is not already in the list. Add it to the list
803 set TRG(dirs_in_use) [list]
805 proc dirs_nHelper {} {
807 llength $TRG(dirs_in_use)
809 proc dirs_freeDir {iDir} {
812 foreach d $TRG(dirs_in_use) {
813 if {$iDir!=$d} { lappend out $d }
815 if {[llength $out]!=[llength $TRG(dirs_in_use)]-1} {
816 error "dirs_freeDir could not
find $iDir"
818 set TRG(dirs_in_use) $out
820 proc dirs_allocDir {} {
822 array set inuse [list]
823 foreach d $TRG(dirs_in_use) {
826 for {set iRet 0} {[info exists inuse($iRet)]} {incr iRet} { }
827 lappend TRG(dirs_in_use) $iRet
831 # Check that directory $dir exists. If it does not, create it. If
832 # it does, delete its contents.
834 proc create_or_clear_dir {dir} {
835 set dir [file normalize $dir]
836 catch { file mkdir $dir }
837 foreach f [glob -nocomplain [file join $dir *]] {
838 catch { file delete -force $f }
842 proc build_to_dirname {bname} {
843 set fold [string tolower [string map {- _} $bname]]
844 return "testrunner_build_
$fold"
847 #-------------------------------------------------------------------------
849 proc r_write_db {tcl} {
850 trdb eval { BEGIN EXCLUSIVE }
855 # Obtain a new job to be run by worker $iJob (an integer). A job is
856 # returned as a three element list:
858 # {$build $config $file}
860 proc r_get_next_job {iJob} {
864 set orderby "ORDER BY priority ASC
"
866 set orderby "ORDER BY priority DESC
"
873 SELECT
* FROM
jobs AS j WHERE state
='ready' $orderby LIMIT
1
875 trdb eval $query job {
876 set tm [clock_milliseconds]
878 set jobid $job(jobid)
881 UPDATE jobs SET starttime=$tm, state='running' WHERE jobid=$jobid
884 set ret [array get job]
893 # add_job OPTION ARG OPTION ARG...
895 # where available OPTIONS are:
905 # Returns the jobid value for the new job.
907 proc add_job {args} {
910 -displaytype -displayname -build -dirname
911 -cmd -depid -priority
914 # Set default values of options.
922 # Check all required options are present. And that no extras are present.
924 if {[info exists A($o)]==0} { error "missing required option
$o" }
926 foreach o [array names A] {
927 if {[lsearch -exact $options $o]<0} { error "unrecognized option
: $o" }
931 if {$A(-depid)==""} { set state ready }
935 displaytype, displayname, build, dirname, cmd, depid, priority,
949 trdb last_insert_rowid
952 # Argument $build is either an empty string, or else a list of length 3
953 # describing the job to build testfixture. In the usual form:
955 # {ID DIRNAME DISPLAYNAME}
959 # {1 /home/user/sqlite/test/testrunner_bld_xyz All-Debug}
961 proc add_tcl_jobs {build config patternlist {shelldepid ""}} {
964 set topdir [file dirname $::testdir]
965 set testrunner_tcl [file normalize [info script]]
968 set testfixture [info nameofexec]
970 set testfixture [file join [lindex $build 1] $TRG(testfixture)]
972 if {[lindex $build 2]=="Valgrind
"} {
973 set setvar "export OMIT_MISUSE
=1\n"
974 set testfixture "${setvar}valgrind
-v --error-exitcode=1 $testfixture"
977 # The ::testspec array is populated by permutations.test
978 foreach f [dict get $::testspec($config) -files] {
980 if {[llength $patternlist]>0} {
982 foreach p $patternlist {
983 set p [string trim $p *]
984 if {[string index $p 0]=="^
"} {
985 set p [string range $p 1 end]
989 if {[string index $p end]=="\$
"} {
990 set p [string range $p 0 end-1]
994 if {[string match $p "$config [file tail $f]"]} {
999 if {$bMatch==0} continue
1002 if {[file pathtype $f]!="absolute
"} { set f [file join $::testdir $f] }
1003 set f [file normalize $f]
1005 set displayname [string map [list $topdir/ {}] $f]
1006 if {$config=="full
" || $config=="veryquick
"} {
1007 set cmd "$testfixture $f"
1009 set cmd "$testfixture $testrunner_tcl $config $f"
1010 set displayname "config
=$config $displayname"
1013 set displayname "[lindex
$build 2] $displayname"
1016 set lProp [trd_test_script_properties $f]
1018 if {[lsearch $lProp slow]>=0} { set priority 2 }
1019 if {[lsearch $lProp superslow]>=0} { set priority 4 }
1021 set depid [lindex $build 0]
1022 if {$shelldepid!="" && [lsearch $lProp shell]>=0} { set depid $shelldepid }
1026 -displayname $displayname \
1033 proc add_build_job {buildname target {postcmd ""} {depid ""}} {
1036 set dirname "[string tolower
[string map
{- _
} $buildname]]_
$target"
1037 set dirname "testrunner_bld_
$dirname"
1039 set cmd "$TRG(makecmd
) $target"
1047 -displayname "Build
$buildname ($target)" \
1055 list $id [file normalize $dirname] $buildname
1058 proc add_shell_build_job {buildname dirname depid} {
1061 if {$TRG(platform)=="win
"} {
1062 set path [string map {/ \\} "$dirname/"]
1063 set copycmd "xcopy
$TRG(shell
) $path"
1065 set copycmd "cp $TRG(shell
) $dirname/"
1069 add_build_job $buildname $TRG(shell) $copycmd $depid
1074 proc add_make_job {bld target} {
1077 if {$TRG(platform)=="win
"} {
1078 set path [string map {/ \\} [lindex $bld 1]]
1079 set cmd "xcopy
/S
$path\\* .
"
1081 set cmd "cp -r [lindex
$bld 1]/* .
"
1083 append cmd "\n$TRG(makecmd
) $target"
1087 -displayname "[lindex
$bld 2] make $target" \
1089 -depid [lindex $bld 0] \
1093 proc add_fuzztest_jobs {buildname} {
1095 foreach {interpreter scripts} [trd_fuzztest_data] {
1096 set subcmd [lrange $interpreter 1 end]
1097 set interpreter [lindex $interpreter 0]
1099 set bld [add_build_job $buildname $interpreter]
1100 foreach {depid dirname displayname} $bld {}
1102 foreach s $scripts {
1104 # Fuzz data files fuzzdata1.db and fuzzdata2.db are larger than
1105 # the others. So ensure that these are run as a higher priority.
1106 set tail [file tail $s]
1107 if {$tail=="fuzzdata1.db
" || $tail=="fuzzdata2.db
"} {
1115 -displayname "$buildname $interpreter $tail" \
1117 -cmd "[file join $dirname $interpreter] $subcmd $s" \
1123 proc add_zipvfs_jobs {} {
1125 source [file join $TRG(zipvfs) test zipvfs_testrunner.tcl]
1127 set bld [add_build_job Zipvfs $TRG(testfixture)]
1128 foreach s [zipvfs_testrunner_files] {
1129 set cmd "[file join [lindex
$bld 1] $TRG(testfixture
)] $s"
1132 -displayname "Zipvfs
[file tail $s]" \
1134 -depid [lindex $bld 0]
1137 set ::env(SQLITE_TEST_DIR) $::testdir
1140 # Used to add jobs for "mdevtest
" and "sdevtest
".
1142 proc add_devtest_jobs {lBld patternlist} {
1146 set bld [add_build_job $b $TRG(testfixture)]
1147 add_tcl_jobs $bld veryquick $patternlist SHELL
1148 if {$patternlist==""} {
1149 add_fuzztest_jobs $b
1152 if {[trdb one "SELECT EXISTS
(SELECT
1 FROM
jobs WHERE depid
='SHELL')"]} {
1153 set sbld [add_shell_build_job $b [lindex $bld 1] [lindex $bld 0]]
1154 set sbldid [lindex $sbld 0]
1156 UPDATE jobs SET depid=$sbldid WHERE depid='SHELL'
1163 # Check to ensure that the interpreter is a full-blown "testfixture
"
1164 # build and not just a "tclsh
". If this is not the case, issue an
1165 # error message and exit.
1167 proc must_be_testfixture {} {
1168 if {[lsearch [info commands] sqlite3_soft_heap_limit]<0} {
1169 puts "Use testfixture
, not tclsh
, for these arguments.
"
1174 proc add_jobs_from_cmdline {patternlist} {
1177 if {$TRG(zipvfs)!=""} {
1179 if {[llength $patternlist]==0} return
1182 if {[llength $patternlist]==0} {
1183 set patternlist [list veryquick]
1186 set first [lindex $patternlist 0]
1190 set patternlist [lrange $patternlist 1 end]
1191 set clist [trd_all_configs]
1193 add_tcl_jobs "" $c $patternlist
1203 add_devtest_jobs $config_set [lrange $patternlist 1 end]
1211 add_devtest_jobs $config_set [lrange $patternlist 1 end]
1215 set patternlist [lrange $patternlist 1 end]
1216 foreach b [trd_builds $TRG(platform)] {
1217 if {$TRG(config)!="" && ![regexp "\\y
$b\\y
" $TRG(config)]} continue
1218 if {[regexp "\\y
$b\\y
" $TRG(omitconfig)]} continue
1219 set bld [add_build_job $b $TRG(testfixture)]
1220 foreach c [trd_configs $TRG(platform) $b] {
1221 add_tcl_jobs $bld $c $patternlist SHELL
1224 if {$patternlist==""} {
1225 foreach e [trd_extras $TRG(platform) $b] {
1226 if {$e=="fuzztest
"} {
1227 add_fuzztest_jobs $b
1229 add_make_job $bld $e
1234 if {[trdb one "SELECT EXISTS
(SELECT
1
1235 FROM
jobs WHERE depid
='SHELL')"]} {
1236 set sbld [add_shell_build_job $b [lindex $bld 1] [lindex $bld 0]]
1237 set sbldid [lindex $sbld 0]
1239 UPDATE jobs SET depid=$sbldid WHERE depid='SHELL'
1246 set allperm [array names ::testspec]
1247 lappend allperm all mdevtest sdevtest release list
1248 puts "Allowed values
for the PERMUTATION argument
: [lsort
$allperm]"
1254 if {[info exists ::testspec($first)]} {
1255 add_tcl_jobs "" $first [lrange $patternlist 1 end]
1257 add_tcl_jobs "" full $patternlist
1263 proc make_new_testset {} {
1266 trdb eval {PRAGMA journal_mode=WAL;}
1268 trdb eval $TRG(schema)
1270 set cmdline $TRG(cmdline)
1271 set tm [clock_milliseconds]
1272 trdb eval { REPLACE INTO config VALUES('njob', $nJob ); }
1273 trdb eval { REPLACE INTO config VALUES('cmdline', $cmdline ); }
1274 trdb eval { REPLACE INTO config VALUES('start', $tm ); }
1276 add_jobs_from_cmdline $TRG(patternlist)
1281 proc mark_job_as_finished {jobid output state endtm} {
1285 if {[regexp {\y(\d+) errors out of (\d+) tests} $output all a b]} {
1289 regexp {\y\d+ errors out of \d+ tests (on [^\n]+-bit \S+-endian)} \
1291 regexp {\ySQLite \d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d [0-9a-fA-F]+} \
1295 if {$state=="failed
"} {
1297 if {$nerr<=0} {set nerr 1}
1299 set childstate ready
1303 SET output=$output, state=$state, endtime=$endtm,
1304 ntest=$ntest, nerr=$nerr, svers=$svers, pltfm=$pltfm
1306 UPDATE jobs SET state=$childstate WHERE depid=$jobid;
1311 proc script_input_ready {fd iJob jobid} {
1317 trdb eval { SELECT * FROM jobs WHERE jobid=$jobid } job {}
1319 # If this job specified a directory name, then delete the run.sh/run.bat
1320 # file from it before continuing. This is because the contents of this
1321 # directory might be copied by some other job, and we don't want to copy
1322 # the run.sh file in this case.
1323 if {$job(dirname)!=""} {
1324 file delete -force [file join $job(dirname) $TRG(run)]
1328 fconfigure $fd -blocking 1
1330 set rc [catch { close $fd } msg]
1332 if {[info exists TRG(reportlength)]} {
1333 puts -nonewline "[string repeat
" " $TRG(reportlength
)]\r"
1335 puts "FAILED
: $job(displayname
) ($iJob)"
1337 if {$TRG(stopOnError)} {
1338 puts "OUTPUT
: $O($iJob)"
1341 if {$TRG(stopOnCore) && [string first {core dumped} $O($iJob)]>0} {
1342 puts "OUTPUT
: $O($iJob)"
1347 set tm [clock_milliseconds]
1348 set jobtm [expr {$tm - $job(starttime)}]
1350 puts $TRG(log) "### $job(displayname) ${jobtm}ms ($state)"
1351 puts
$TRG(log
) [string trim
$O($iJob)]
1353 mark_job_as_finished
$jobid $O($iJob) $state $tm
1359 set rc
[catch
{ gets
$fd line
} res
]
1364 append O
($iJob) "$line\n"
1374 proc launch_another_job
{iJob
} {
1379 set testfixture
[info nameofexec
]
1380 set script $TRG(info_script
)
1384 set jobdict
[r_get_next_job
$iJob]
1385 if {$jobdict==""} { return 0 }
1386 array
set job
$jobdict
1388 set dir
$job(dirname)
1389 if {$dir==""} { set dir
[dirname $iJob] }
1390 create_or_clear_dir
$dir
1392 if {$job(build
)!=""} {
1393 set srcdir
[file dirname $
::testdir
]
1394 if {$job(build
)=="Zipvfs"} {
1395 set script [zipvfs_testrunner_script
]
1397 set bWin
[expr {$TRG(platform
)=="win"}]
1398 set script [trd_buildscript
$job(build
) $srcdir $bWin]
1400 set fd
[open
[file join $dir $TRG(make)] w
]
1405 # Add a batch/shell file command to set the directory used for temp
1406 # files to the test's working directory. Otherwise, tests that use
1407 # large numbers of temp files (e.g. zipvfs), might generate temp
1408 # filename collisions.
1409 if {$TRG(platform
)=="win"} {
1410 set set_tmp_dir
"SET SQLITE_TMPDIR=[file normalize $dir]"
1412 set set_tmp_dir
"export SQLITE_TMPDIR=\"[file normalize $dir]\""
1415 if { $TRG(dryrun
) } {
1417 mark_job_as_finished
$job(jobid
) "" done 0
1419 if {$job(build
)!=""} {
1420 puts
$TRG(log
) "(cd $dir ; $job(cmd) )"
1422 puts
$TRG(log
) "$job(cmd)"
1428 set fd
[open
$TRG(run
) w
]
1429 puts
$fd $set_tmp_dir
1432 set fd
[open
"|$TRG(runcmd) 2>@1" r
]
1435 fconfigure
$fd -blocking false
-translation binary
1436 fileevent
$fd readable
[list script_input_ready
$fd $iJob $job(jobid
)]
1442 # Show the testing progress report
1444 proc progress_report
{} {
1447 if {$TRG(fullstatus
)} {
1448 if {$
::tcl_platform
(platform
)=="windows"} {
1449 exec [info nameofexe
] $
::argv0 status
--cls
1454 set tm
[expr [clock_milliseconds
] - $TRG(starttime
)]
1455 set tm
[format
"%d" [expr int
($tm/1000.0 + 0.5)]]
1459 SELECT displaytype
, state
, count
(*) AS cnt
1463 set v
($state,$displaytype) $cnt
1464 incr t
($displaytype) $cnt
1469 foreach j
[lsort
[array names t
]] {
1470 foreach k
{done failed running
} { incr v
($k,$j) 0 }
1471 set fin
[expr $v(done,$j) + $v(failed
,$j)]
1472 lappend text
"${j}($fin/$t($j))"
1473 if {$v(failed
,$j)>0} {
1474 lappend text
"f$v(failed,$j)"
1476 if {$v(running
,$j)>0} {
1477 lappend text
"r$v(running,$j)"
1481 if {[info exists TRG
(reportlength
)]} {
1482 puts
-nonewline "[string repeat " " $TRG(reportlength)]\r"
1484 set report
"${tm} [join $text { }]"
1485 set TRG
(reportlength
) [string length
$report]
1486 if {[string length
$report]<100} {
1487 puts
-nonewline "$report\r"
1493 after
$TRG(reporttime
) progress_report
1496 proc launch_some_jobs
{} {
1498 set nJob
[trdb one
{ SELECT value FROM config WHERE name
='njob' }]
1500 while {[dirs_nHelper
]<$nJob} {
1501 set iDir
[dirs_allocDir
]
1502 if {0==[launch_another_job
$iDir]} {
1509 proc run_testset
{} {
1513 set TRG
(starttime
) [clock_milliseconds
]
1514 set TRG
(log
) [open
$TRG(logname
) w
]
1518 if {$TRG(fullstatus
)} {puts
"\033\[2J"}
1520 while {[dirs_nHelper
]>0} {
1521 after
500 {incr
::wakeup
}
1528 set tm
[clock_milliseconds
]
1529 trdb
eval { REPLACE INTO config VALUES
('end', $tm ); }
1530 set nErr
[trdb one
{SELECT count
(*) FROM
jobs WHERE state
='failed'}]
1532 puts
"$nErr failures:"
1534 SELECT displayname FROM
jobs WHERE state
='failed'
1536 puts
"FAILED: $displayname"
1539 set nOmit
[trdb one
{SELECT count
(*) FROM
jobs WHERE state
='omit'}]
1541 puts
"$nOmit jobs skipped due to prior failures"
1545 puts
"\nTest database is $TRG(dbname)"
1546 puts
"Test log is $TRG(logname)"
1548 SELECT
sum(ntest
) AS totaltest
,
1549 sum(nerr
) AS totalerr
1553 SELECT max
(endtime
)-min(starttime
) AS totaltime
1554 FROM
jobs WHERE endtime
>0
1556 set et
[elapsetime
$totaltime]
1559 SELECT pltfm
, count
(*) FROM
jobs WHERE pltfm IS NOT NULL
1560 ORDER BY
2 DESC LIMIT
1
1562 puts
"$totalerr errors out of $totaltest tests in $et $pltfm"
1564 SELECT DISTINCT substr
(svers
,1,80) FROM
jobs WHERE svers IS NOT NULL
1569 # Handle the --buildonly option, if it was specified.
1571 proc handle_buildonly
{} {
1573 if {$TRG(buildonly
)} {
1575 trdb
eval { DELETE FROM
jobs WHERE displaytype
!='bld' }
1580 # Handle the --explain option. Provide a human-readable
1581 # explanation of all the tests that are in the trdb database jobs
1584 proc explain_layer
{indent depid
} {
1586 if {$TRG(buildonly
)} {
1591 trdb
eval {SELECT jobid
, displayname
, displaytype
, dirname
1592 FROM
jobs WHERE depid
=$depid ORDER BY displayname
} {
1593 if {$displaytype=="bld"} {
1594 puts
"${indent}$displayname in $dirname"
1595 explain_layer
"${indent} " $jobid
1596 } elseif
{$showtests} {
1597 set tail [lindex
$displayname end
]
1598 set e1
[lindex
$displayname 1]
1599 if {[string match config
=* $e1]} {
1600 set cfg
[string range
$e1 7 end
]
1601 puts
"${indent}($cfg) $tail"
1603 puts
"${indent}$tail"
1608 proc explain_tests
{} {
1612 sqlite3 trdb
$TRG(dbname
)
1613 trdb timeout
$TRG(timeout
)
1614 set tm
[lindex
[time { make_new_testset
}] 0]
1615 if {$TRG(explain
)} {
1619 puts
"splitting work across $TRG(nJob) cores"
1621 puts
"built testset in [expr $tm/1000]ms.."