]> git.ipfire.org Git - thirdparty/sqlite.git/commitdiff
Add options to wapptest.tcl similar to those supported by releasetest.tcl. Also add...
authordan <dan@noemail.net>
Thu, 2 May 2019 17:06:01 +0000 (17:06 +0000)
committerdan <dan@noemail.net>
Thu, 2 May 2019 17:06:01 +0000 (17:06 +0000)
FossilOrigin-Name: 005a169406ccea6e3cc42271620870d985e8bada1ad49a63656003db4911cb51

manifest
manifest.uuid
test/wapptest.tcl

index e5b6b667a65e9efca66ae3808f7c7a410726a473..3aedc4b0978a4e71086a5d9e742d2e0653a4267e 100644 (file)
--- 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
index c188b9ab55debe1eb5841a0c955fd5d4246ed2dd..32b722ccd82330e4ad8f117629062623a6641e9d 100644 (file)
@@ -1 +1 @@
-c509d8a8aebe0da4847e95cf737c21313a665de9a540da2db57b8ed22f98a402
\ No newline at end of file
+005a169406ccea6e3cc42271620870d985e8bada1ad49a63656003db4911cb51
\ No newline at end of file
index 88f0f074bf4e661fa9e507593728194118fb80d3..62488a1eacfd2fd268b7195d69126c4ce7cdfd35 100755 (executable)
@@ -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 {} {
   }
 }
 
+# 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
-wapp-start $argv
+if {$G(noui)==0} {
+  wapp-start $lWappArg
+} else {
+  wapptest_run
+  do_some_stuff
+  vwait forever
+}