From: dan Date: Wed, 13 Jul 2022 21:02:07 +0000 (+0000) Subject: Add new script test/testrunner.tcl. For running a set of test scripts using X-Git-Tag: version-3.40.0~306 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=2bb2d53bca5c0d6d8e405487f9ea5543a743e274;p=thirdparty%2Fsqlite.git Add new script test/testrunner.tcl. For running a set of test scripts using multiple processes. FossilOrigin-Name: 0122e93dc19c228546908b9ef5c58f88d27d79233523e2d09a4bbd56b0c492f9 --- 2bb2d53bca5c0d6d8e405487f9ea5543a743e274 diff --cc manifest index efe77e8f88,e22ffa00e1..44e348e1cf --- a/manifest +++ b/manifest @@@ -1,5 -1,5 +1,5 @@@ - C The\squery\sflattener\sshould\snot\srun\sif\sthe\ssubquery\sis\sa\scompound\sthat\scontains\na\sRIGHT\sJOIN\sin\sany\sarm\sand\sthe\ssubquery\sis\snot\sthe\sfirst\selement\sof\sthe\nouter\squery.\s\sOtherwise,\sprior\selements\sof\sthe\souter\squery\swill\snot\shave\nthe\sJT_LTORJ\sflag\sset.\s\sFix\sfor\sthe\sproblem\sreported\sin\n[forum:/forumpost/174afeae5734d42d|forum\spost\s174afeae5734d42d]. - D 2022-07-13T15:52:15.028 -C Fix\sa\sproblem\spreventing\s"testrunnter.tcl\sall"\sfrom\sworking. -D 2022-07-13T20:26:37.216 ++C Add\snew\sscript\stest/testrunner.tcl.\sFor\srunning\sa\sset\sof\stest\sscripts\susing\nmultiple\sprocesses. ++D 2022-07-13T21:02:07.599 F .fossil-settings/empty-dirs dbb81e8fc0401ac46a1491ab34a7f2c7c0452f2f06b54ebb845d024ca8283ef1 F .fossil-settings/ignore-glob 35175cdfcf539b2318cb04a9901442804be81cd677d8b889fcc9149c21f239ea F LICENSE.md df5091916dbb40e6e9686186587125e1b2ff51f022cc334e886c19a0e9982724 @@@ -1507,6 -1507,8 +1507,8 @@@ F test/temptable2.test d2940417496e2b95 F test/temptable3.test d11a0974e52b347e45ee54ef1923c91ed91e4637 F test/temptrigger.test 38f0ca479b1822d3117069e014daabcaacefffcc F test/tester.tcl 76771269dcc20b2c2d1d6f1175dd50d1eebddc004aebac865483f1829a5cd398 -F test/testrunner.tcl 297f066a0c2c78e552a29060701825fcfd16cd915c19d51654112d54df2feacc ++F test/testrunner.tcl 39e43ba90d8fe2d2694049af5ac53861c04a42600d3a8ccb1d07eaaaf350c806 + F test/testset.tcl 27a6bbbc93cbbcf442c57e3c023e6b5d7304dc415e09eb0e9ac61edd0e6c1fbe F test/thread001.test b61a29dd87cf669f5f6ac96124a7c97d71b0c80d9012746072055877055cf9ef F test/thread002.test e630504f8a06c00bf8bbe68528774dd96aeb2e58 F test/thread003.test ee4c9efc3b86a6a2767516a37bd64251272560a7 @@@ -1979,8 -1981,8 +1981,8 @@@ F vsixtest/vsixtest.tcl 6a9a6ab600c25a9 F vsixtest/vsixtest.vcxproj.data 2ed517e100c66dc455b492e1a33350c1b20fbcdc F vsixtest/vsixtest.vcxproj.filters 37e51ffedcdb064aad6ff33b6148725226cd608e F vsixtest/vsixtest_TemporaryKey.pfx e5b1b036facdb453873e7084e1cae9102ccc67a0 - P d1d019bfa2f62b0dc39bba42e17786ca2e4362b6d11d206e5445a051a0f93ae0 - R 8ba9f41e04ffe4b4f2fce5afccce75ed - U drh - Z 64b6a3b4244651c63a98e29aa670c738 -P 900febcf362fa5f592c640d16177f33c13aab11ce31a61c7e18ff1be6e70bf9b -R 0ad59c4f151fdc0de195dce40012b69c ++P 274e244c85935084b2f0f85176283f018bf9b74e7703f985bd5a2f6f8bdcff5d 0ed1e83c6fc12acd06ecf7210a869bebaf5e5e75762e5f16bf1834ecab717d59 ++R 6e5b00a7e5284e8563026668673ce8cf + U dan -Z f4f6164f8a169ec2d085a00d87e67f68 ++Z 363eb180a41ae46020bac6b29842c080 # Remove this line to create a well-formed Fossil manifest. diff --cc manifest.uuid index 29d537888d,025c54bb03..5b94b4fbde --- a/manifest.uuid +++ b/manifest.uuid @@@ -1,1 -1,1 +1,1 @@@ - 274e244c85935084b2f0f85176283f018bf9b74e7703f985bd5a2f6f8bdcff5d -0ed1e83c6fc12acd06ecf7210a869bebaf5e5e75762e5f16bf1834ecab717d59 ++0122e93dc19c228546908b9ef5c58f88d27d79233523e2d09a4bbd56b0c492f9 diff --cc test/testrunner.tcl index 0000000000,f3863f2023..9d04b252b0 mode 000000,100644..100644 --- a/test/testrunner.tcl +++ b/test/testrunner.tcl @@@ -1,0 -1,521 +1,530 @@@ + + + #------------------------------------------------------------------------- + # Usage: + # + proc usage {} { - puts stderr "Usage: $::argv0 ?SWITCHES? ?PATTERN? ..." ++ set a0 testrunner.tcl ++ ++ puts stderr "Usage: $a0 ?SWITCHES? ?PATTERN? ..." + puts stderr "" + puts stderr "where SWITCHES are:" + puts stderr " --jobs NUMBER-OF-JOBS" ++ puts stderr "" ++ puts stderr "Examples:" ++ puts stderr " $a0 # Run veryquick.test tests" ++ puts stderr " $a0 all # Run all tests" ++ puts stderr " $a0 veryquick rtree% # Run all test scripts from veryquick.test that match 'rtree%'" ++ puts stderr " $a0 alter% fts5% # Run all test scripts that match 'alter%' or 'rtree%'" ++ + exit 1 + } + #------------------------------------------------------------------------- + + #------------------------------------------------------------------------- + # The database schema used by the testrunner.db database. + # + set R(schema) { + DROP TABLE IF EXISTS script; + DROP TABLE IF EXISTS msg; + DROP TABLE IF EXISTS malloc; + + CREATE TABLE script( + filename TEXT PRIMARY KEY, -- full path to test script + state TEXT CHECK( state IN ('ready', 'running', 'done') ), + testfixtureid, -- Id of process that ran script + time INTEGER, -- Time in ms + nerr INTEGER, -- if 'done', the number of errors + ntest INTEGER, -- if 'done', the number of tests + output TEXT -- full output of test script + ); + + CREATE TABLE malloc( + id INTEGER PRIMARY KEY, + nmalloc INTEGER, + nbyte INTEGER, + leaker TEXT + ); + + CREATE TABLE msg( + id INTEGER PRIMARY KEY, + msg TEXT + ); + } + #------------------------------------------------------------------------- + + #------------------------------------------------------------------------- + # Try to estimate a the number of processes to use. + # + # Command [guess_number_of_cores] attempts to glean the number of logical + # cores. Command [default_njob] returns the default value for the --jobs + # switch. + # + proc guess_number_of_cores {} { + set ret 4 + catch { + set fd [open "|nproc" r] + set ret [gets $fd] + close $fd + set ret [expr $ret] + } + return $ret + } + + proc default_njob {} { + set nCore [guess_number_of_cores] + set nHelper [expr int($nCore*0.75)] + expr $nHelper>0 ? $nHelper : 1 + } + #------------------------------------------------------------------------- + + + set R(dbname) [file normalize testrunner.db] + set R(logname) [file normalize testrunner.log] + set R(info_script) [file normalize [info script]] + set R(timeout) 10000 ;# Default busy-timeout for testrunner. + set R(nJob) [default_njob] ;# Default number of helper processes + set R(leaker) "" ;# Name of first script to leak memory + + set R(patternlist) [list] + + set testdir [file dirname $argv0] + source $testdir/testset.tcl + + # Parse the command line options. There are two ways to invoke this + # script - to create a helper or coordinator process. If there are + # no helper processes, the coordinator runs test scripts. + # + # To create a helper process: + # + # testrunner.tcl helper ID + # + # where ID is an integer greater than 0. The process will create and + # run tests in the "testdir$ID" directory. Helper processes are only + # created by coordinators - there is no need for a user to create + # helper processes manually. + # + # If the first argument is anything other than "helper", then a coordinator + # process is started. See the implementation of the [usage] proc above for + # details. + # + switch -- [lindex $argv 0] { + helper { + set R(helper) 1 + set R(helper_id) [lindex $argv 1] + set argv [list --testdir=testdir$R(helper_id)] + } + + default { + set R(helper) 0 + set R(helper_id) 0 + + } + } + if {$R(helper)==0} { + for {set ii 0} {$ii < [llength $argv]} {incr ii} { + set a [lindex $argv $ii] + set n [string length $a] + + if {[string range $a 0 0]=="-"} { + if {($n>2 && [string match "$a*" --jobs]) || $a=="-j"} { + incr ii + set R(nJob) [lindex $argv $ii] + } else { + usage + } + } else { + lappend R(patternlist) [string map {% * _ .} $a] + } + } + + set argv [list] + } + + source $testdir/tester.tcl + db close + + + proc r_write_db {tcl} { + global R + sqlite3 db $R(dbname) + db timeout $R(timeout) + db eval { BEGIN EXCLUSIVE } + + uplevel $tcl + + db eval { COMMIT } + db close + } + + proc make_new_testset {} { + global R + + set scripts [testset_patternlist $R(patternlist)] + r_write_db { + db eval $R(schema) + foreach s $scripts { + db eval { INSERT INTO script(filename, state) VALUES ($s, 'ready') } + } + } + } + + proc get_next_test {} { + global R + set myid $R(helper_id) + + r_write_db { + set f [db one { + SELECT filename FROM script WHERE state='ready' ORDER BY 1 LIMIT 1 + }] + if {$f!=""} { + db eval { + UPDATE script SET state='running', testfixtureid=$myid WHERE filename=$f + } + } + } + + return $f + } + + proc r_set_test_result {filename ms nerr ntest output} { + global R + + set f [file tail $filename] + if {$nerr==0} { + set msg "$f... Ok" + } else { + set msg "$f... FAILED - $nerr errors of $ntest tests" + } + append msg " (${ms}ms)" + if {$R(helper)} { + append msg " (helper $R(helper_id))" + } + + sqlite3_shutdown + set nMalloc [lindex [sqlite3_status SQLITE_STATUS_MALLOC_COUNT 0] 1] + set nByte [sqlite3_memory_used] + if {($nByte>0 || $nMalloc>0) && $R(leaker)==""} { + set R(leaker) $filename + } + + r_write_db { + db eval { + UPDATE script + SET state='done', output=$output, nerr=$nerr, ntest=$ntest, time=$ms + WHERE filename=$filename; + + INSERT INTO msg(msg) VALUES ($msg); + } + } + } + + set R(iNextMsg) 1 + proc r_get_messages {{db ""}} { + global R + + if {$db==""} { + sqlite3 rgmhandle $R(dbname) + set dbhandle rgmhandle + $dbhandle timeout $R(timeout) + } else { + set dbhandle $db + } + + $dbhandle transaction { + set next $R(iNextMsg) + set ret [$dbhandle eval {SELECT msg FROM msg WHERE id>=$next}] + set R(iNextMsg) [$dbhandle one {SELECT COALESCE(max(id), 0)+1 FROM msg}] + } + + if {$db==""} { + rgmhandle close + } + + set ret + } + + # This is called after all tests have been run to write the leaked memory + # report into the malloc table of testrunner.db. + # + proc r_memory_report {} { + global R + + sqlite3_shutdown + + set nMalloc [lindex [sqlite3_status SQLITE_STATUS_MALLOC_COUNT 0] 1] + set nByte [sqlite3_memory_used] + set id $R(helper_id) + set leaker $R(leaker) + + r_write_db { + db eval { + INSERT INTO malloc(id, nMalloc, nByte, leaker) + VALUES($id, $nMalloc, $nByte, $leaker) + } + } + } + + + #-------------------------------------------------------------------------- + # + set ::R_INSTALL_PUTS_WRAPPER { + proc puts_sts_wrapper {args} { + set n [llength $args] + if {$n==1 || ($n==2 && [string first [lindex $args 0] -nonewline]==0)} { + uplevel puts_into_caller $args + } else { + # A channel was explicitly specified. + uplevel puts_sts_original $args + } + } + rename puts puts_sts_original + proc puts {args} { uplevel puts_sts_wrapper $args } + } + + proc r_install_puts_wrapper {} $::R_INSTALL_PUTS_WRAPPER + proc r_uninstall_puts_wrapper {} { + rename puts "" + rename puts_sts_original puts + } + + proc slave_test_script {script} { + + # Create the interpreter used to run the test script. + interp create tinterp + + # Populate some global variables that tester.tcl expects to see. + foreach {var value} [list \ + ::argv0 $::argv0 \ + ::argv {} \ + ::SLAVE 1 \ + ] { + interp eval tinterp [list set $var $value] + } + + # The alias used to access the global test counters. + tinterp alias set_test_counter set_test_counter + + # Set up an empty ::cmdlinearg array in the slave. + interp eval tinterp [list array set ::cmdlinearg [array get ::cmdlinearg]] + + # Set up the ::G array in the slave. + interp eval tinterp [list array set ::G [array get ::G]] + interp eval tinterp [list set ::G(runner.tcl) 1] + + interp eval tinterp $::R_INSTALL_PUTS_WRAPPER + tinterp alias puts_into_caller puts_into_caller + + # Load the various test interfaces implemented in C. + load_testfixture_extensions tinterp + + # Run the test script. + set rc [catch { interp eval tinterp $script } msg opt] + if {$rc} { + puts_into_caller $msg + puts_into_caller [dict get $opt -errorinfo] + incr ::TC(errors) + } + + # Check if the interpreter call [run_thread_tests] + if { [interp eval tinterp {info exists ::run_thread_tests_called}] } { + set ::run_thread_tests_called 1 + } + + # Delete the interpreter used to run the test script. + interp delete tinterp + } + + proc slave_test_file {zFile} { + set tail [file tail $zFile] + + # Remember the value of the shared-cache setting. So that it is possible + # to check afterwards that it was not modified by the test script. + # + ifcapable shared_cache { set scs [sqlite3_enable_shared_cache] } + + # Run the test script in a slave interpreter. + # + unset -nocomplain ::run_thread_tests_called + reset_prng_state + set ::sqlite_open_file_count 0 + set time [time { slave_test_script [list source $zFile] }] + set ms [expr [lindex $time 0] / 1000] + + r_install_puts_wrapper + + # Test that all files opened by the test script were closed. Omit this + # if the test script has "thread" in its name. The open file counter + # is not thread-safe. + # + if {[info exists ::run_thread_tests_called]==0} { + do_test ${tail}-closeallfiles { expr {$::sqlite_open_file_count>0} } {0} + } + set ::sqlite_open_file_count 0 + + # Test that the global "shared-cache" setting was not altered by + # the test script. + # + ifcapable shared_cache { + set res [expr {[sqlite3_enable_shared_cache] == $scs}] + do_test ${tail}-sharedcachesetting [list set {} $res] 1 + } + + # Add some info to the output. + # + output2 "Time: $tail $ms ms" + show_memstats + + r_uninstall_puts_wrapper + return $ms + } + + proc puts_into_caller {args} { + global R + if {[llength $args]==1} { + append R(output) [lindex $args 0] + append R(output) "\n" + } else { + append R(output) [lindex $args 1] + } + } + + #------------------------------------------------------------------------- + # + proc r_final_report {} { + global R + + sqlite3 db $R(dbname) + db timeout $R(timeout) + + set errcode 0 + + # Create the text log file. This is just the concatenation of the + # 'output' column of the database for every script that was run. + set fd [open $R(logname) w] + db eval {SELECT output FROM script ORDER BY filename} { + puts $fd $output + } + close $fd + + # Check if any scripts reported errors. If so, print one line noting + # how many errors, and another identifying the scripts in which they + # occured. Or, if no errors occurred, print out "no errors at all!". + sqlite3 db $R(dbname) + db timeout $R(timeout) + db eval { SELECT sum(nerr) AS nerr, sum(ntest) AS ntest FROM script } { } + puts "$nerr errors from $ntest tests." + if {$nerr>0} { + db eval { SELECT filename FROM script WHERE nerr>0 } { + lappend errlist [file tail $filename] + } + puts "Errors in: $errlist" + set errcode 1 + } + + # Check if any scripts were not run or did not finish. Print out a + # line identifying them if there are any. + set errlist [list] + db eval { SELECT filename FROM script WHERE state!='done' } { + lappend errlist [file tail $filename] + } + if {$errlist!=[list]} { + puts "Tests DID NOT FINISH (crashed?): $errlist" + set errcode 1 + } + + set bLeak 0 + db eval { + SELECT id, nmalloc, nbyte, leaker FROM malloc + WHERE nmalloc>0 OR nbyte>0 + } { + if {$id==0} { + set line "This process " + } else { + set line "Helper $id " + } + append line "leaked $nbyte byte in $nmalloc allocations" + if {$leaker!=""} { append line " (perhaps in [file tail $leaker])" } + puts $line + set bLeak 1 + } + if {$bLeak==0} { + puts "No leaks - all allocations freed." + } + + db close + + puts "Test database is $R(dbname)" + puts "Test log file is $R(logname)" + if {$errcode} { + puts "This test has FAILED." + } + return $errcode + } + + + if {$R(helper)==0} { + make_new_testset + } + + set R(nHelperRunning) 0 + if {$R(helper)==0 && $R(nJob)>1} { + cd $cmdlinearg(TESTFIXTURE_HOME) + for {set ii 1} {$ii <= $R(nJob)} {incr ii} { + set cmd "[info nameofexec] $R(info_script) helper $ii 2>@1" + puts "Launching helper $ii ($cmd)" + set chan [open "|$cmd" r] + fconfigure $chan -blocking false + fileevent $chan readable [list r_helper_readable $ii $chan] + incr R(nHelperRunning) + } + cd $cmdlinearg(testdir) + } + + proc r_helper_readable {id chan} { + set data [gets $chan] + if {$data!=""} { puts "helper $id:[gets $chan]" } + if {[eof $chan]} { + puts "helper $id is finished" + incr ::R(nHelperRunning) -1 + close $chan + } + } + + if {$R(nHelperRunning)==0} { + while { ""!=[set f [get_next_test]] } { + set R(output) "" + set TC(count) 0 + set TC(errors) 0 + set ms [slave_test_file $f] + + r_set_test_result $f $ms $TC(errors) $TC(count) $R(output) + + if {$R(helper)==0} { + foreach msg [r_get_messages] { puts $msg } + } + } + + # Tests are finished - write a record into testrunner.db describing + # any memory leaks. + r_memory_report + + } else { + set TTT 0 + sqlite3 db $R(dbname) + db timeout $R(timeout) + while {$R(nHelperRunning)>0} { + after 250 { incr TTT } + vwait TTT + foreach msg [r_get_messages db] { puts $msg } + } + db close + } + + set errcode 0 + if {$R(helper)==0} { + set errcode [r_final_report] + } + + exit $errcode +