Further tweaks to wapptest.tcl. Add the ability to run the extra (n)debug tests that...

FossilOrigin-Name: ec9c4f6d8da25dcc834812c2bb24bda1017833b1c572bdbbf87f0191e1310706

diff --git a/manifest b/manifest
index bec038d046d27bbf23a3cafc5367a271e1bf0a27..b3b5999f0c788deb663d0026bf45596ba098daec 100644 (file)
--- a/manifest
+++ b/manifest
@@ -1,5 +1,5 @@
-C Fix\sthe\schecksymbols\starget\sin\sMakefile.in.
-D 2019-04-11T06:50:52.687
+C Further\stweaks\sto\swapptest.tcl.\sAdd\sthe\sability\sto\srun\sthe\sextra\s(n)debug\stests\sthat\sreleasetest.tcl\sruns.
+D 2019-04-11T19:03:15.406
 F .fossil-settings/empty-dirs dbb81e8fc0401ac46a1491ab34a7f2c7c0452f2f06b54ebb845d024ca8283ef1
 F .fossil-settings/ignore-glob 35175cdfcf539b2318cb04a9901442804be81cd677d8b889fcc9149c21f239ea
 F LICENSE.md df5091916dbb40e6e9686186587125e1b2ff51f022cc334e886c19a0e9982724
@@ -1227,7 +1227,7 @@ F test/regexp1.test 497ea812f264d12b6198d6e50a76be4a1973a9d8
 F test/regexp2.test 40e894223b3d6672655481493f1be12012f2b33c
 F test/reindex.test 44edd3966b474468b823d481eafef0c305022254
 F test/releasetest.tcl 7712811e0f4e2f198ec786cb2e1352b3793d7395f48a3cceef0572d8823eb75e x
-F test/releasetest_data.tcl 1a89107e0f3be09efa9819367ffd96dbe9b82d571c03a75ba19444ca2432d05e
+F test/releasetest_data.tcl c3746248b5ad8f99a29020f83501bb25e024156ecc37e05c71c76da4fc8601c6
 F test/resetdb.test 8062cf10a09d8c048f8de7711e94571c38b38168db0e5877ba7561789e5eeb2b
 F test/resolver01.test f4022acafda7f4d40eca94dbf16bc5fc4ac30ceb
 F test/rollback.test 06680159bc6746d0f26276e339e3ae2f951c64812468308838e0a3362d911eaa
@@ -1651,7 +1651,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 e2ceb8d8e2d36fabb2717c52488fd3a5a59f7810b255e0f455dc0326de69ba0f x
+F test/wapptest.tcl a7ea78efd76045c1c9c5ee43964e359e6aaceeffbe52168ab370f128400e3938 x
 F test/where.test 0607caa5a1fbfe7b93b95705981b463a3a0408038f22ae6e9dc11b36902b0e95
 F test/where2.test 478d2170637b9211f593120648858593bf2445a1
 F test/where3.test 2341a294e17193a6b1699ea7f192124a5286ca6acfcc3f4b06d16c931fbcda2c
@@ -1817,7 +1817,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 c47e53b4d0f29628bd20ba3daf7e759c4bfed07710d982c095445c01376d57f5
-R 3723816e896d55a0d5f9bdcd61b8be60
+P 1956eb348170a9a873878b522f377fa7303cdb3beca41f5515b6b9da1b1f544d
+R 5ac35a0406aee95794a9fe46e0ff36c7
 U dan
-Z 08174164d0ec219d71d5119412864f95
+Z 9c597e1a63109035dfeab32dc661484e

diff --git a/manifest.uuid b/manifest.uuid
index 08391cfd882c3c5f53019f250165cf60bb480c1e..7fda591aa0392ce5e16b0d50e8b9a4becb87de6c 100644 (file)
--- a/manifest.uuid
+++ b/manifest.uuid
@@ -1 +1 @@
-1956eb348170a9a873878b522f377fa7303cdb3beca41f5515b6b9da1b1f544d
\ No newline at end of file
+ec9c4f6d8da25dcc834812c2bb24bda1017833b1c572bdbbf87f0191e1310706
\ No newline at end of file

diff --git a/test/releasetest_data.tcl b/test/releasetest_data.tcl
index fe08f629ba321f5a45f6a087161b1245c8903e34..3afd659f99c871c7dd5f3104e3022b882003f48d 100644 (file)
--- a/test/releasetest_data.tcl
+++ b/test/releasetest_data.tcl
@@ -387,7 +387,7 @@ proc make_test_suite {msvc withtcl name testtarget config} {
 
   # Set the sub-directory to use.
   #
-  set dir [string tolower [string map {- _ " " _} $name]]
+  set dir [string tolower [string map {- _ " " _ "(" _ ")" _} $name]]
 
   # Join option lists into strings, using space as delimiter.
   #

diff --git a/test/wapptest.tcl b/test/wapptest.tcl
index 708561d79dbb8a70a85d36817d77a422f1ed0612..2ad6df2c37cce3871f0608223f260b3353226a36 100755 (executable)
--- a/test/wapptest.tcl
+++ b/test/wapptest.tcl
@@ -1,4 +1,4 @@
-#!/bin/sh 
+#!/bin/sh
 # \
 exec wapptclsh "$0" ${1+"$@"}
 
@@ -22,13 +22,14 @@ set G(platform) $::tcl_platform(os)-$::tcl_platform(machine)
 set G(test)     Normal
 set G(keep)     0
 set G(msvc)     0
-set G(tcl)      ""
+set G(tcl)      [::tcl::pkgconfig get libdir,install]
 set G(jobs)     3
+set G(debug)    0
 
 proc wapptest_init {} {
   global G
 
-  set lSave [list platform test keep msvc tcl jobs] 
+  set lSave [list platform test keep msvc tcl jobs debug] 
   foreach k $lSave { set A($k) $G($k) }
   array unset G
   foreach k $lSave { set G($k) $A($k) }
@@ -44,8 +45,9 @@ proc wapptest_init {} {
   # Either "config", "running" or "stopped":
   set G(state) "config"
 
-  set G(host) "(unknown host)"
-  catch { set G(host) [exec hostname] } 
+  set G(hostname) "(unknown host)"
+  catch { set G(hostname) [exec hostname] } 
+  set G(host) $G(hostname)
   append G(host) " $::tcl_platform(os) $::tcl_platform(osVersion)"
   append G(host) " $::tcl_platform(machine) $::tcl_platform(byteOrder)"
 }
@@ -65,6 +67,29 @@ proc check_uncommitted {} {
   return $ret
 }
 
+proc generate_fossil_info {} {
+  global G
+  set pwd [pwd]
+  cd $G(srcdir)
+  if {[catch {exec fossil info}    r1]} return
+  if {[catch {exec fossil changes} r2]} return
+  cd $pwd
+
+  foreach line [split $r1 "\n"] {
+    if {[regexp {^checkout: *(.*)$} $line -> co]} {
+      wapp-trim { <br> %html($co) }
+    }
+  }
+
+  if {[string trim $r2]!=""} {
+    wapp-trim { 
+      <br><span class=warning> 
+      WARNING: Uncommitted changes in checkout
+      </span>
+    }
+  }
+}
+
 # If the application is in "config" state, set the contents of the 
 # ::G(test_array) global to reflect the tests that will be run. If the
 # app is in some other state ("running" or "stopped"), this command
@@ -102,6 +127,22 @@ proc set_test_array {} {
       }
 
       lappend G(test_array) [dict create config $config target $target]
+
+      set exclude [list checksymbols valgrindtest fuzzoomtest]
+      if {$G(debug) && !($target in $exclude)} {
+        set debug_idx [lsearch -glob $::Configs($config) -DSQLITE_DEBUG*]
+        set xtarget $target
+        regsub -all {fulltest[a-z]*} $xtarget test xtarget
+        if {$debug_idx<0} {
+          lappend G(test_array) [
+            dict create config $config-(Debug) target $target
+          ]
+        } else {
+          lappend G(test_array) [
+            dict create config $config-(NDebug) target $xtarget
+          ]
+        }
+      }
     }
   }
 }
@@ -242,7 +283,26 @@ proc do_some_stuff {} {
         fileevent $fd readable [list slave_fileevent $name]
 
         puts $fd [list 0 $G(msvc) 0 $G(keep)]
-        set L [make_test_suite $G(msvc) "" $name $target $::Configs($name)]
+
+        set wtcl ""
+        if {$G(tcl)!=""} { set wtcl "--with-tcl=$G(tcl)" }
+
+        # If this configuration is named <name>-(Debug) or <name>-(NDebug),
+        # then add or remove the SQLITE_DEBUG option from the base
+        # configuration before running the test.
+        if {[regexp -- {(.*)-(\(.*\))} $name -> head tail]} {
+          set opts $::Configs($head)
+          if {$tail=="(Debug)"} {
+            append opts " -DSQLITE_DEBUG=1 -DSQLITE_EXTRA_IFNULLROW=1"
+          } else {
+            regsub { *-DSQLITE_MEMDEBUG[^ ]* *} $opts { } opts
+            regsub { *-DSQLITE_DEBUG[^ ]* *} $opts { } opts
+          }
+        } else {
+          set opts $::Configs($name)
+        }
+
+        set L [make_test_suite $G(msvc) $wtcl $name $target $opts]
         puts $fd $L
         flush $fd
         set G(test.$name.log) [file join [lindex $L 1] test.log]
@@ -269,30 +329,25 @@ proc generate_main_page {{extra {}}} {
   global G
   set_test_array
 
-  # <meta http-equiv="refresh" content="5; URL=/">
+  set hostname $G(hostname)
   wapp-trim {
     <html>
     <head>
+      <title> %html($hostname): wapptest.tcl </title>
       <link rel="stylesheet" type="text/css" href="style.css"/>
     </head>
     <body>
   }
 
-  # If the checkout contains uncommitted changs, put a warning at the top
-  # of the page.
-  if {[check_uncommitted]} {
-    wapp-trim {
-      <div class=warning>
-        WARNING: Uncommitted changes in checkout.
-      </div>
-    }
-  }
-
   set host $G(host)
   wapp-trim {
-      <div class=div>%string($host)</div>
-      <div class=div id=controls> 
-      <form action="control" method="post" name="control">
+    <div class="border">%string($host)
+  }
+  generate_fossil_info
+  wapp-trim {
+    </div>
+    <div class="border" id=controls> 
+    <form action="control" method="post" name="control">
   }
 
   # Build the "platform" select widget. 
@@ -336,6 +391,8 @@ proc generate_main_page {{extra {}}} {
         </input>
         <label> Use MSVC: </label>
         <input id="control_msvc" name="control_msvc" type=checkbox value=1>
+        <label> Debug tests: </label>
+        <input id="control_debug" name="control_debug" type=checkbox value=1>
         </input>
   }
   wapp-trim {
@@ -343,7 +400,7 @@ proc generate_main_page {{extra {}}} {
   }
   wapp-trim {
      </div>
-     <div class=div2 id=tests>
+     <div id=tests>
   }
   wapp-page-tests
 
@@ -362,7 +419,7 @@ proc wapp-default {} {
 
 proc wapp-page-tests {} {
   global G
-  wapp-trim { <table> }
+  wapp-trim { <table class="border" width=100%> }
   foreach t $G(test_array) {
     set config [dict get $t config]
     set target [dict get $t target]
@@ -391,10 +448,10 @@ proc wapp-page-tests {} {
 
     wapp-trim {
       <tr class=%string($class)>
-      <td class=testfield> %html($config) 
-      <td class=testfield> %html($target)
-      <td class=testfield> %html($seconds)
-      <td class=testfield>
+      <td class="nowrap"> %html($config) 
+      <td class="padleft nowrap"> %html($target)
+      <td class="padleft nowrap"> %html($seconds)
+      <td class="padleft nowrap">
     }
     if {[info exists G(test.$config.log)]} {
       set log $G(test.$config.log)
@@ -407,8 +464,7 @@ proc wapp-page-tests {} {
       set errmsg $G(test.$config.errmsg)
       wapp-trim {
         <tr class=testfail>
-        <td class=testfield>
-        <td class=testfield colspan=3> %html($errmsg)
+        <td> <td class="padleft" colspan=3> %html($errmsg)
       }
     }
   }
@@ -430,11 +486,11 @@ proc wapp-page-tests {} {
 #
 proc wapp-page-control {} {
   global G
-  catch { puts [wapp-param control_msvc] }
   if {$::G(state)=="config"} {
-    set lControls [list platform test tcl jobs keep msvc]
+    set lControls [list platform test tcl jobs keep msvc debug]
     set G(msvc) 0
     set G(keep) 0
+    set G(debug) 0
   } else {
     set lControls [list jobs]
   }
@@ -482,12 +538,8 @@ proc wapp-page-control {} {
 #
 proc wapp-page-style.css {} {
   wapp-subst {
-    .div {
-      border: 3px groove #444444;
-      margin: 1em;
-      padding: 1em;
-    }
 
+    /* The boxes with black borders use this class */
     .border {
       border: 3px groove #444444;
       padding: 1em;
@@ -495,35 +547,24 @@ proc wapp-page-style.css {} {
       margin-bottom: 1em;
     }
 
-    .div2 {
-      margin: 1em;
-    }
-
-    table {
-      padding: 1em;
-      width:100%;
-      border: 3px groove #444444;
-    }
+    /* Float to the right (used for the Run/Stop/Reset button) */
+    .right { float: right; }
 
+    /* Style for the large red warning at the top of the page */
     .warning {
-      text-align:center;
       color: red;
-      font-size: 2em;
       font-weight: bold;
     }
 
-    .testfield {
-      padding-right: 10ex;
-      white-space: nowrap;
-    }
-
-    .testwait {}
-    .testrunning { color: blue }
-    .testdone { color: green }
-    .testfail { color: red }
-
-    .right { float: right; }
+    /* Styles used by cells in the test table */
+    .padleft { padding-left: 5ex; }
+    .nowrap  { white-space: nowrap; }
 
+    /* Styles for individual tests, depending on the outcome */
+    .testwait    {              }
+    .testrunning { color: blue  }
+    .testdone    { color: green }
+    .testfail    { color: red   }
   }
 }
 
@@ -540,10 +581,11 @@ proc wapp-page-script {} {
   set tcl $::G(tcl)
   set keep $::G(keep)
   set msvc $::G(msvc)
+  set debug $::G(debug)
   
   wapp-subst {
     var lElem = \["control_platform", "control_test", "control_msvc", 
-        "control_jobs"
+        "control_jobs", "control_debug"
     \];
     lElem.forEach(function(e) {
       var elem = document.getElementById(e);
@@ -558,6 +600,9 @@ proc wapp-page-script {} {
 
     elem = document.getElementById("control_msvc");
     elem.checked = %string($msvc);
+
+    elem = document.getElementById("control_debug");
+    elem.checked = %string($debug);
   }
 
   if {$script != "config.js"} {