diff --git a/manifest b/manifest index efe77e8f88..44e348e1cf 100644 --- a/manifest +++ b/manifest @@ -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 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 @@ F test/temptable2.test d2940417496e2b9548e01d09990763fbe88c316504033256d51493e1f F test/temptable3.test d11a0974e52b347e45ee54ef1923c91ed91e4637 F test/temptrigger.test 38f0ca479b1822d3117069e014daabcaacefffcc F test/tester.tcl 76771269dcc20b2c2d1d6f1175dd50d1eebddc004aebac865483f1829a5cd398 +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 @@ F vsixtest/vsixtest.tcl 6a9a6ab600c25a91a7acc6293828957a386a8a93 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 274e244c85935084b2f0f85176283f018bf9b74e7703f985bd5a2f6f8bdcff5d 0ed1e83c6fc12acd06ecf7210a869bebaf5e5e75762e5f16bf1834ecab717d59 +R 6e5b00a7e5284e8563026668673ce8cf +U dan +Z 363eb180a41ae46020bac6b29842c080 # Remove this line to create a well-formed Fossil manifest. diff --git a/manifest.uuid b/manifest.uuid index 29d537888d..5b94b4fbde 100644 --- a/manifest.uuid +++ b/manifest.uuid @@ -1 +1 @@ -274e244c85935084b2f0f85176283f018bf9b74e7703f985bd5a2f6f8bdcff5d \ No newline at end of file +0122e93dc19c228546908b9ef5c58f88d27d79233523e2d09a4bbd56b0c492f9 \ No newline at end of file diff --git a/test/testrunner.tcl b/test/testrunner.tcl new file mode 100644 index 0000000000..9d04b252b0 --- /dev/null +++ b/test/testrunner.tcl @@ -0,0 +1,530 @@ + + +#------------------------------------------------------------------------- +# Usage: +# +proc usage {} { + 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 + diff --git a/test/testset.tcl b/test/testset.tcl new file mode 100644 index 0000000000..8f761d686a --- /dev/null +++ b/test/testset.tcl @@ -0,0 +1,121 @@ + + +# Commands in this file: +# +# testset_all +# Return a list of all test scripts designed to be run individually. +# +# testset_veryquick +# The subset of [testset_all] meant to run as veryquick.test. +# + +set D(testdir) [file dir [file normalize [info script]]] + +proc testset_all {} { + global D + set ret [list] + + # The following tests are driver scripts that themselves run lots of other + # test scripts. They should be ignored here. + set drivers { + all.test async.test quick.test veryquick.test + memleak.test permutations.test soak.test fts3.test + mallocAll.test rtree.test full.test extraquick.test + session.test rbu.test + } + + set srcdir [file dirname $D(testdir)] + set ret [glob -nocomplain \ + $srcdir/test/*.test \ + $srcdir/ext/rtree/*.test \ + $srcdir/ext/fts5/test/*.test \ + $srcdir/ext/expert/*.test \ + $srcdir/ext/session/*.test \ + ] + set ret [ts_filter $ret $drivers] + return $ret +} + +proc testset_veryquick {} { + set ret [testset_all] + + set ret [ts_filter $ret { + async2.test async3.test backup_ioerr.test corrupt.test + corruptC.test crash.test crash2.test crash3.test crash4.test crash5.test + crash6.test crash7.test delete3.test e_fts3.test fts3rnd.test + fkey_malloc.test fuzz.test fuzz3.test fuzz_malloc.test in2.test loadext.test + misc7.test mutex2.test notify2.test onefile.test pagerfault2.test + savepoint4.test savepoint6.test select9.test + speed1.test speed1p.test speed2.test speed3.test speed4.test + speed4p.test sqllimits1.test tkt2686.test thread001.test thread002.test + thread003.test thread004.test thread005.test trans2.test vacuum3.test + incrvacuum_ioerr.test autovacuum_crash.test btree8.test shared_err.test + vtab_err.test walslow.test walcrash.test walcrash3.test + walthread.test rtree3.test indexfault.test securedel2.test + sort3.test sort4.test fts4growth.test fts4growth2.test + bigsort.test walprotocol.test mmap4.test fuzzer2.test + walcrash2.test e_fkey.test backup.test + + fts4merge.test fts4merge2.test fts4merge4.test fts4check.test + fts4merge5.test + fts3cov.test fts3snippet.test fts3corrupt2.test fts3an.test + fts3defer.test fts4langid.test fts3sort.test fts5unicode.test + + rtree4.test + sessionbig.test + }] + + set ret [ts_filter $ret { + *malloc* *ioerr* *fault* *bigfile* *_err* *fts5corrupt* *fts5big* *fts5aj* + }] + + return $ret +} + +proc ts_filter {input exlist} { + foreach f $input { set a($f) 1 } + foreach e $exlist { array unset a */$e } + array names a +} + +proc testset_patternlist {patternlist} { + set nPat [llength $patternlist] + + if {$nPat==0} { + set scripts [testset_veryquick] + } else { + set ii 0 + set p0 [lindex $patternlist 0] + + if {$p0=="veryquick"} { + set scripts [testset_veryquick] + incr ii + } elseif {$p0=="all"} { + set scripts [testset_all] + incr ii + } else { + set scripts [testset_all] + } + + if {$nPat>$ii} { + array set S [list] + foreach f $scripts { set a([file tail $f]) $f } + + foreach p [lrange $patternlist $ii end] { + set nList [llength [array names a $p]] + if {$nList==0} { + puts stderr "Argument $p matches no scripts (typo?)" + exit 1 + } + foreach n [array names a $p] { set S($a($n)) 1 } + } + + set scripts [lsort [array names S]] + } + + } + + set scripts +} + +