From ee253f7881ddf736ab67d15ccd8df97027111fd4 Mon Sep 17 00:00:00 2001 From: dan Date: Thu, 2 May 2019 17:06:01 +0000 Subject: [PATCH] Add options to wapptest.tcl similar to those supported by releasetest.tcl. Also add the -noui switch, for running without wapp altogether. FossilOrigin-Name: 005a169406ccea6e3cc42271620870d985e8bada1ad49a63656003db4911cb51 --- manifest | 14 ++-- manifest.uuid | 2 +- test/wapptest.tcl | 192 +++++++++++++++++++++++++++++++++++++++++++--- 3 files changed, 189 insertions(+), 19 deletions(-) diff --git a/manifest b/manifest index e5b6b667a6..3aedc4b097 100644 --- a/manifest +++ b/manifest @@ -1,5 +1,5 @@ -C Earlier\sdetection\sof\sa\sdatabase\scorruption\scase\sin\sbalance_nonroot(),\sto\nprevent\sa\spossible\suse\sof\san\suninitialized\svariable. -D 2019-05-02T15:56:39.144 +C Add\soptions\sto\swapptest.tcl\ssimilar\sto\sthose\ssupported\sby\sreleasetest.tcl.\sAlso\sadd\sthe\s-noui\sswitch,\sfor\srunning\swithout\swapp\saltogether. +D 2019-05-02T17:06:01.169 F .fossil-settings/empty-dirs dbb81e8fc0401ac46a1491ab34a7f2c7c0452f2f06b54ebb845d024ca8283ef1 F .fossil-settings/ignore-glob 35175cdfcf539b2318cb04a9901442804be81cd677d8b889fcc9149c21f239ea F LICENSE.md df5091916dbb40e6e9686186587125e1b2ff51f022cc334e886c19a0e9982724 @@ -1656,7 +1656,7 @@ F test/walslow.test c05c68d4dc2700a982f89133ce103a1a84cc285f F test/walthread.test 14b20fcfa6ae152f5d8e12f5dc8a8a724b7ef189f5d8ef1e2ceab79f2af51747 F test/walvfs.test c0faffda13d045a96dfc541347886bb1a3d6f3205857fc98e683edfab766ea88 F test/wapp.tcl b440cd8cf57953d3a49e7ee81e6a18f18efdaf113b69f7d8482b0710a64566ec -F test/wapptest.tcl 32a23f9b4c9fa1126d29250368ba6d5689b7503aa0694df7edf9253f1d56f1d7 x +F test/wapptest.tcl f387e81750b2938ccf445b8a061541626a4a31f55e9e500b3e38ef3ce177bc61 x F test/where.test 0607caa5a1fbfe7b93b95705981b463a3a0408038f22ae6e9dc11b36902b0e95 F test/where2.test 478d2170637b9211f593120648858593bf2445a1 F test/where3.test 2341a294e17193a6b1699ea7f192124a5286ca6acfcc3f4b06d16c931fbcda2c @@ -1822,7 +1822,7 @@ F vsixtest/vsixtest.tcl 6a9a6ab600c25a91a7acc6293828957a386a8a93 F vsixtest/vsixtest.vcxproj.data 2ed517e100c66dc455b492e1a33350c1b20fbcdc F vsixtest/vsixtest.vcxproj.filters 37e51ffedcdb064aad6ff33b6148725226cd608e F vsixtest/vsixtest_TemporaryKey.pfx e5b1b036facdb453873e7084e1cae9102ccc67a0 -P b043a54c3de54b286c4eae564eab6b99118a410d99bdb63480faba3123d2ca11 -R 18ab7c62d0e00aa10b61e04e6385c846 -U drh -Z 008cd703689ead8de489aed4e8570f99 +P c509d8a8aebe0da4847e95cf737c21313a665de9a540da2db57b8ed22f98a402 +R ae122c629293e3edebd8b79e5ad2d64a +U dan +Z 2ff4926d40df66aaffbb2191925f93c2 diff --git a/manifest.uuid b/manifest.uuid index c188b9ab55..32b722ccd8 100644 --- a/manifest.uuid +++ b/manifest.uuid @@ -1 +1 @@ -c509d8a8aebe0da4847e95cf737c21313a665de9a540da2db57b8ed22f98a402 \ No newline at end of file +005a169406ccea6e3cc42271620870d985e8bada1ad49a63656003db4911cb51 \ No newline at end of file diff --git a/test/wapptest.tcl b/test/wapptest.tcl index 88f0f074bf..62488a1eac 100755 --- a/test/wapptest.tcl +++ b/test/wapptest.tcl @@ -21,15 +21,19 @@ source [file join [file dirname [info script]] releasetest_data.tcl] set G(platform) $::tcl_platform(os)-$::tcl_platform(machine) set G(test) Normal set G(keep) 1 -set G(msvc) [expr {$::tcl_platform(platform)=="windows"}] +set G(msvc) 0 set G(tcl) [::tcl::pkgconfig get libdir,install] set G(jobs) 3 set G(debug) 0 +set G(noui) 0 +set G(stdout) 0 + + proc wapptest_init {} { global G - set lSave [list platform test keep msvc tcl jobs debug] + set lSave [list platform test keep msvc tcl jobs debug noui stdout] foreach k $lSave { set A($k) $G($k) } array unset G foreach k $lSave { set G($k) $A($k) } @@ -49,6 +53,22 @@ proc wapptest_init {} { append G(host) " $::tcl_platform(machine) $::tcl_platform(byteOrder)" } +proc wapptest_run {} { + global G + set_test_array + set G(state) "running" + + wapptest_openlog + + wapptest_output "Running the following for $G(platform). $G(jobs) jobs." + foreach t $G(test_array) { + set config [dict get $t config] + set target [dict get $t target] + wapptest_output [format " %-25s%s" $config $target] + } + wapptest_output [string repeat * 70] +} + # Generate the text for the box at the top of the UI. The current SQLite # version, according to fossil, along with a warning if there are # uncommitted changes in the checkout. @@ -197,6 +217,31 @@ proc count_tests_and_errors {name logfile} { } } +proc wapptest_output {str} { + global G + if {$G(stdout)} { puts $str } + if {[info exists G(log)]} { + puts $G(log) $str + flush $G(log) + } +} +proc wapptest_openlog {} { + global G + set G(log) [open wapptest-out.txt w+] +} +proc wapptest_closelog {} { + global G + close $G(log) + unset G(log) +} + +proc format_seconds {seconds} { + set min [format %.2d [expr ($seconds / 60) % 60]] + set hr [format %.2d [expr $seconds / 3600]] + set sec [format %.2d [expr $seconds % 60]] + return "$hr:$min:$sec" +} + # This command is invoked once a slave process has finished running its # tests, successfully or otherwise. Parameter $name is the name of the # test, $rc the exit code returned by the slave process. @@ -233,6 +278,18 @@ proc slave_test_done {name rc} { } } } + + # Format a message regarding the success or failure of hte test. + set t [format_seconds [expr $G(test.$name.done) - $G(test.$name.start)]] + set res "OK" + if {$G(test.$name.nError)} { set res "FAILED" } + set dots [string repeat . [expr 60 - [string length $name]]] + set msg "$name $dots $res ($t)" + + wapptest_output $msg + if {[info exists G(test.$name.errmsg)] && $G(test.$name.errmsg)!=""} { + wapptest_output " $G(test.$config.errmsg)" + } } # This is a fileevent callback invoked each time a file-descriptor that @@ -372,10 +429,15 @@ proc do_some_stuff {} { incr nConfig } set G(result) "$nError errors from $nTest tests in $nConfig configurations." + wapptest_output [string repeat * 70] + wapptest_output $G(result) catch { append G(result) " SQLite version $G(sqlite_version)" + wapptest_output " SQLite version $G(sqlite_version)" } set G(state) "stopped" + wapptest_closelog + if {$G(noui)} { exit 0 } } else { set nLaunch [expr $G(jobs) - $nRunning] foreach j $G(test_array) { @@ -543,11 +605,7 @@ proc wapp-page-tests {} { } set seconds [expr $G(test.$config.done) - $G(test.$config.start)] } - - set min [format %.2d [expr ($seconds / 60) % 60]] - set hr [format %.2d [expr $seconds / 3600]] - set sec [format %.2d [expr $seconds % 60]] - set seconds "$hr:$min:$sec" + set seconds [format_seconds $seconds] } wapp-trim { @@ -606,8 +664,7 @@ proc wapp-page-control {} { if {[wapp-param-exists control_run]} { # This is a "run test" command. - set_test_array - set ::G(state) "running" + wapptest_run } if {[wapp-param-exists control_stop]} { @@ -622,6 +679,7 @@ proc wapp-page-control {} { slave_test_done $name 1 } } + wapptest_closelog } if {[wapp-param-exists control_reset]} { @@ -773,6 +831,118 @@ proc wapp-page-log {} { } } -wapptest_init -wapp-start $argv +# Print out a usage message. Then do [exit 1]. +# +proc wapptest_usage {} { + puts stderr { +This Tcl script is used to test various configurations of SQLite. By +default it uses "wapp" to provide an interactive interface. Supported +command line options (all optional) are: + + --platform PLATFORM (which tests to run) + --smoketest (run "make smoketest" only) + --veryquick (run veryquick.test only) + --buildonly (build executables, do not run tests) + --jobs N (number of concurrent jobs) + --tcl DIR (where to find tclConfig.sh) + --deletefiles (delete extra files after each test) + --msvc (Use MS Visual C) + --debug (Also run [n]debugging versions of tests) + --noui (do not use wapp) + } + exit 1 +} + +# Sort command line arguments into two groups: those that belong to wapp, +# and those that belong to the application. +set WAPPARG(-server) 1 +set WAPPARG(-local) 1 +set WAPPARG(-scgi) 1 +set WAPPARG(-remote-scgi) 1 +set WAPPARG(-fromip) 1 +set WAPPARG(-nowait) 0 +set WAPPARG(-cgi) 0 +set lWappArg [list] +set lTestArg [list] +for {set i 0} {$i < [llength $argv]} {incr i} { + set arg [lindex $argv $i] + if {[string range $arg 0 1]=="--"} { + set arg [string range $arg 1 end] + } + if {[info exists WAPPARG($arg)]} { + lappend lWappArg $arg + if {$WAPPARG($arg)} { + incr i + lappend lWappArg [lindex $argv $i] + } + } else { + lappend lTestArg $arg + } +} + +for {set i 0} {$i < [llength $lTestArg]} {incr i} { + switch -- [lindex $lTestArg $i] { + -platform { + if {$i==[llength $lTestArg]-1} { wapptest_usage } + incr i + set arg [lindex $lTestArg $i] + set lPlatform [array names ::Platforms] + if {[lsearch $lPlatform $arg]<0} { + puts stderr "No such platform: $arg. Platforms are: $lPlatform" + exit -1 + } + set G(platform) $arg + } + + -smoketest { set G(test) Smoketest } + -veryquick { set G(test) Veryquick } + -buildonly { set G(test) Build-Only } + -jobs { + if {$i==[llength $lTestArg]-1} { wapptest_usage } + incr i + set G(jobs) [lindex $lTestArg $i] + } + + -tcl { + if {$i==[llength $lTestArg]-1} { wapptest_usage } + incr i + set G(tcl) [lindex $lTestArg $i] + } + + -deletefiles { + set G(keep) 0 + } + + -msvc { + set G(msvc) 1 + } + + -debug { + set G(debug) 1 + } + + -noui { + set G(noui) 1 + set G(stdout) 1 + } + + -stdout { + set G(stdout) 1 + } + + default { + puts stderr "Unrecognized option: [lindex $lTestArg $i]" + wapptest_usage + } + } +} + +wapptest_init +if {$G(noui)==0} { + wapp-start $lWappArg +} else { + wapptest_run + do_some_stuff + vwait forever +}