/ Check-in [cbf42365]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Various fixes for the wapptest.tcl script.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | wapptest
Files: files | file ages | folders
SHA3-256: cbf423656047f0cb5200be6981a205e0ae206eef8263aa686f4a3621fb07fb57
User & Date: dan 2019-04-10 18:56:30
Context
2019-04-10
19:45
Have wapptest.tcl display the name, OS and architecture of the host. check-in: c47e53b4 user: dan tags: wapptest
18:56
Various fixes for the wapptest.tcl script. check-in: cbf42365 user: dan tags: wapptest
2019-04-09
19:53
Add test/wapptest.tcl, a wapp alternative to releasetest.tcl. check-in: a4af0c2f user: dan tags: wapptest
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to test/wapptest.tcl.

     1      1   #!/bin/sh 
     2      2   # \
     3      3   exec wapptclsh "$0" ${1+"$@"}
     4      4   
            5  +# package required wapp
            6  +source [file join [file dirname [info script]] wapp.tcl]
            7  +
            8  +# Read the data from the releasetest_data.tcl script.
     5      9   #
     6         -#
     7         -#
           10  +source [file join [file dirname [info script]] releasetest_data.tcl]
     8     11   
     9     12   # Variables set by the "control" form:
    10     13   #
    11     14   #   G(platform) - User selected platform.
    12     15   #   G(test)     - Set to "Normal", "Veryquick", "Smoketest" or "Build-Only".
    13     16   #   G(keep)     - Boolean. True to delete no files after each test.
    14     17   #   G(msvc)     - Boolean. True to use MSVC as the compiler.
................................................................................
    18     21   set G(platform) $::tcl_platform(os)-$::tcl_platform(machine)
    19     22   set G(test)     Normal
    20     23   set G(keep)     0
    21     24   set G(msvc)     0
    22     25   set G(tcl)      ""
    23     26   set G(jobs)     3
    24     27   
    25         -set G(sqlite_version) unknown
    26         -
    27         -# The root of the SQLite source tree.
    28         -#
    29         -set G(srcdir)   [file dirname [file dirname [info script]]]
    30         -
    31         -# Either "config", "running", "stopped":
    32         -#
    33         -set G(state) "config"
    34         -
    35         -# releasetest.tcl script
    36         -#
    37         -set G(releaseTest) [file join [file dirname [info script]] releasetest.tcl]
    38         -
    39         -set G(cnt) 0
    40         -
    41         -# package required wapp
    42         -source [file join [file dirname [info script]] wapp.tcl]
    43         -
    44         -# Read the data from the releasetest_data.tcl script.
    45         -#
    46         -source [file join [file dirname [info script]] releasetest_data.tcl]
           28  +proc wapptest_init {} {
           29  +  global G
           30  +
           31  +  set lSave [list platform test keep msvc tcl jobs] 
           32  +  foreach k $lSave { set A($k) $G($k) }
           33  +  array unset G
           34  +  foreach k $lSave { set G($k) $A($k) }
           35  +
           36  +  # The root of the SQLite source tree.
           37  +  set G(srcdir)   [file dirname [file dirname [info script]]]
           38  +
           39  +  # releasetest.tcl script
           40  +  set G(releaseTest) [file join [file dirname [info script]] releasetest.tcl]
           41  +
           42  +  set G(sqlite_version) "unknown"
           43  +
           44  +  # Either "config", "running" or "stopped":
           45  +  set G(state) "config"
           46  +}
    47     47   
    48     48   # Check to see if there are uncommitted changes in the SQLite source
    49     49   # directory. Return true if there are, or false otherwise.
    50     50   #
    51     51   proc check_uncommitted {} {
    52     52     global G
    53     53     set ret 0
................................................................................
   157    157     } elseif {!$seen} {
   158    158       set G(test.$name.errmsg) "Test did not complete"
   159    159       if {[file readable core]} {
   160    160         append G(test.$name.errmsg) " - core file exists"
   161    161       }
   162    162     }
   163    163   }
          164  +
          165  +proc slave_test_done {name rc} {
          166  +  global G
          167  +  set G(test.$name.done) [clock seconds]
          168  +  set G(test.$name.nError) 0
          169  +  set G(test.$name.nTest) 0
          170  +  set G(test.$name.errmsg) ""
          171  +  if {$rc} {
          172  +    incr G(test.$name.nError)
          173  +  }
          174  +  if {[file exists $G(test.$name.log)]} {
          175  +    count_tests_and_errors $name $G(test.$name.log)
          176  +  }
          177  +}
   164    178   
   165    179   proc slave_fileevent {name} {
   166    180     global G
   167    181     set fd $G(test.$name.channel)
   168    182   
   169    183     if {[eof $fd]} {
   170    184       fconfigure $fd -blocking 1
   171    185       set rc [catch { close $fd }]
   172    186       unset G(test.$name.channel)
   173         -    set G(test.$name.done) [clock seconds]
   174         -    set G(test.$name.nError) 0
   175         -    set G(test.$name.nTest) 0
   176         -    set G(test.$name.errmsg) ""
   177         -    if {$rc} {
   178         -      incr G(test.$name.nError)
   179         -    }
   180         -    if {[file exists $G(test.$name.log)]} {
   181         -      count_tests_and_errors $name $G(test.$name.log)
   182         -    }
          187  +    slave_test_done $name $rc
   183    188     } else {
   184    189       set line [gets $fd]
   185    190       if {[string trim $line] != ""} { puts "Trace   : $name - \"$line\"" }
   186    191     }
   187    192   
   188    193     do_some_stuff
   189    194   }
................................................................................
   211    216         incr nTest $G(test.$name.nTest)
   212    217         incr nConfig 
   213    218       }
   214    219       set G(result) "$nError errors from $nTest tests in $nConfig configurations."
   215    220       catch {
   216    221         append G(result) " SQLite version $G(sqlite_version)"
   217    222       }
          223  +    set G(state) "stopped"
   218    224     } else {
   219    225       set nLaunch [expr $G(jobs) - $nRunning]
   220    226       foreach j $G(test_array) {
   221    227         if {$nLaunch<=0} break
   222    228         set name [dict get $j config]
   223    229         if { ![info exists G(test.$name.channel)]
   224    230           && ![info exists G(test.$name.done)]
................................................................................
   236    242           flush $fd
   237    243           set G(test.$name.log) [file join [lindex $L 1] test.log]
   238    244           incr nLaunch -1
   239    245         }
   240    246       }
   241    247     }
   242    248   }
          249  +
          250  +proc generate_select_widget {label id lOpt opt} {
          251  +  wapp-trim {
          252  +    <label> %string($label) </label>
          253  +    <select id=%string($id) name=%string($id)>
          254  +  }
          255  +  foreach o $lOpt {
          256  +    set selected ""
          257  +    if {$o==$opt} { set selected " selected=1" }
          258  +    wapp-subst "<option $selected>$o</option>"
          259  +  }
          260  +  wapp-trim { </select> }
          261  +}
   243    262   
   244    263   proc generate_main_page {{extra {}}} {
   245    264     global G
   246    265     set_test_array
   247    266   
          267  +  # <meta http-equiv="refresh" content="5; URL=/">
   248    268     wapp-trim {
   249    269       <html>
   250    270       <head>
   251    271         <link rel="stylesheet" type="text/css" href="style.css"/>
   252    272       </head>
   253    273       <body>
   254    274     }
................................................................................
   261    281           WARNING: Uncommitted changes in checkout.
   262    282         </div>
   263    283       }
   264    284     }
   265    285   
   266    286     wapp-trim {
   267    287         <div class=div id=controls> 
   268         -        <form action="control" method="post" name="control">
   269         -        <label> Platform: </label>
   270         -        <select id="control_platform" name="control_platform">
          288  +      <form action="control" method="post" name="control">
   271    289     }
   272         -  foreach platform [array names ::Platforms] {
   273         -    set selected ""
   274         -    if {$platform==$G(platform)} { set selected " selected=1" }
   275         -    wapp-subst "<option $selected>$platform</option>"
          290  +
          291  +  # Build the "platform" select widget. 
          292  +  set lOpt [array names ::Platforms]
          293  +  generate_select_widget Platform control_platform $lOpt $G(platform)
          294  +
          295  +  # Build the "test" select widget. 
          296  +  set lOpt [list Normal Veryquick Smoketest Build-Only] 
          297  +  generate_select_widget Test control_test $lOpt $G(test)
          298  +
          299  +  # Build the "jobs" select widget. Options are 1 to 8.
          300  +  generate_select_widget Jobs control_jobs {1 2 3 4 5 6 7 8} $G(jobs)
          301  +
          302  +  switch $G(state) {
          303  +    config {
          304  +      set txt "Run Tests!"
          305  +      set id control_run
          306  +    }
          307  +    running {
          308  +      set txt "STOP Tests!"
          309  +      set id control_stop
          310  +    }
          311  +    stopped {
          312  +      set txt "Reset!"
          313  +      set id control_reset
          314  +    }
   276    315     }
          316  +  wapp-trim {
          317  +    <div class=right>
          318  +    <input id=%string($id) name=%string($id) type=submit value="%string($txt)">
          319  +    </input>
          320  +    </div>
          321  +  }
          322  +
   277    323     wapp-trim {
   278         -        </select>
   279         -        <label> Test: </label>
   280         -        <select id="control_test" name="control_test">
   281         -  }
   282         -  foreach test [list Normal Veryquick Smoketest Build-Only] {
   283         -    set selected ""
   284         -    if {$test==$G(test)} { set selected " selected=1" }
   285         -    wapp-subst "<option $selected>$test</option>"
   286         -  }
   287         -  wapp-trim [subst -nocommands {
   288         -        </select>
          324  +  <br><br>
   289    325           <label> Tcl: </label>
   290    326           <input id="control_tcl" name="control_tcl"></input>
   291         -
   292    327           <label> Keep files: </label>
   293    328           <input id="control_keep" name="control_keep" type=checkbox value=1>
   294    329           </input>
   295    330           <label> Use MSVC: </label>
   296    331           <input id="control_msvc" name="control_msvc" type=checkbox value=1>
   297    332           </input>
   298         -        <hr>
   299         -        <div class=right>
   300         -          <label> Jobs: </label>
   301         -          <select id="control_jobs" name="control_jobs">
   302         -  }]
   303         -  for {set i 1} {$i <= 8} {incr i} {
   304         -    if {$G(jobs)==$i} {
   305         -      wapp-trim {
   306         -        <option selected=1>%string($i)</option>
   307         -      }
   308         -    } else {
   309         -      wapp-trim {
   310         -        <option>%string($i)</option>
   311         -      }
   312         -    }
   313    333     }
   314    334     wapp-trim {
          335  +     </form>
          336  +  }
          337  +  wapp-trim {
          338  +     </div>
          339  +     <div class=div2 id=tests>
          340  +  }
          341  +  wapp-page-tests
          342  +
          343  +  set script "script/$G(state).js"
          344  +  wapp-trim {
................................................................................
   315         -          </select>
   316         -          <input id=control_go name=control_go type=submit value="Run Tests!">
   317         -          </input>
   318         -        </div>
   319         -     </form>
   320         -      </div>
   321         -      <div class=div id=tests>    
   322         -      <table>
          345  +    </div>
          346  +      <script src=%string($script)></script>
          347  +    </body>
          348  +    </html>
   323    349     }
          350  +}
          351  +
          352  +proc wapp-default {} {
          353  +  generate_main_page
          354  +}
          355  +
          356  +proc wapp-page-tests {} {
          357  +  global G
          358  +  wapp-trim { <table> }
   324    359     foreach t $G(test_array) {
   325    360       set config [dict get $t config]
   326    361       set target [dict get $t target]
   327    362   
   328    363       set class "testwait"
   329    364       set seconds ""
   330    365   
................................................................................
   367    402           <tr class=testfail>
   368    403           <td class=testfield>
   369    404           <td class=testfield colspan=3> %html($errmsg)
   370    405         }
   371    406       }
   372    407     }
   373    408   
   374         -  wapp-trim {
   375         -      </table>
   376         -      </div>
   377         -  }
          409  +  wapp-trim { </table> }
          410  +
   378    411     if {[info exists G(result)]} {
   379    412       set res $G(result)
   380    413       wapp-trim {
   381         -      <div class=div id=log> %string($res) </div>
          414  +      <div class=border id=result> %string($res) </div>
   382    415       }
   383    416     }
   384         -  wapp-trim {
   385         -    <script src="script.js"></script>
   386         -    </body>
   387         -    </html>
   388         -  }
   389         -  incr G(cnt)
   390    417   }
   391    418   
   392         -proc wapp-default {} {
   393         -  generate_main_page
   394         -}
   395         -
          419  +# URI: /control
          420  +#
          421  +# Whenever the form at the top of the application page is submitted, it
          422  +# is submitted here.
          423  +#
   396    424   proc wapp-page-control {} {
   397    425     global G
   398         -  foreach v {platform test tcl jobs keep msvc} {
          426  +  catch { puts [wapp-param control_msvc] }
          427  +  if {$::G(state)=="config"} {
          428  +    set lControls [list platform test tcl jobs keep msvc]
          429  +    set G(msvc) 0
          430  +    set G(keep) 0
          431  +  } else {
          432  +    set lControls [list jobs]
          433  +  }
          434  +  foreach v $lControls {
   399    435       if {[wapp-param-exists control_$v]} {
   400    436         set G($v) [wapp-param control_$v]
   401         -    } else {
   402         -      set G($v) 0
          437  +    }
          438  +  }
          439  +
          440  +  if {[wapp-param-exists control_run]} {
          441  +    # This is a "run test" command.
          442  +    set_test_array
          443  +    set ::G(state) "running"
          444  +  }
          445  +
          446  +  if {[wapp-param-exists control_stop]} {
          447  +    # A "STOP tests" command.
          448  +    set G(state) "stopped"
          449  +    set G(result) "Test halted by user"
          450  +    foreach j $G(test_array) {
          451  +      set name [dict get $j config]
          452  +      if { [info exists G(test.$name.channel)] } {
          453  +        close $G(test.$name.channel)
          454  +        unset G(test.$name.channel)
          455  +        slave_test_done $name 1
          456  +      }
   403    457       }
   404    458     }
   405    459   
   406         -  if {[wapp-param-exists control_go]} {
   407         -    # This is an actual "run test" command, not just a change of 
   408         -    # configuration!
   409         -    set_test_array
   410         -    set ::G(state) "running"
          460  +  if {[wapp-param-exists control_reset]} {
          461  +    # A "reset app" command.
          462  +    set G(state) "config"
          463  +    wapptest_init
   411    464     }
   412    465   
   413    466     if {$::G(state) == "running"} {
   414    467       do_some_stuff
   415    468     }
   416         -
   417    469     wapp-redirect /
   418    470   }
   419    471   
          472  +# URI: /style.css
          473  +#
          474  +# Return the stylesheet for the application main page.
          475  +#
   420    476   proc wapp-page-style.css {} {
   421    477     wapp-subst {
   422    478       .div {
   423    479         border: 3px groove #444444;
   424    480         margin: 1em;
   425    481         padding: 1em;
   426    482       }
          483  +
          484  +    .border {
          485  +      border: 3px groove #444444;
          486  +      padding: 1em;
          487  +      margin-top: 1em;
          488  +      margin-bottom: 1em;
          489  +    }
          490  +
          491  +    .div2 {
          492  +      margin: 1em;
          493  +    }
          494  +
          495  +    table {
          496  +      padding: 1em;
          497  +      width:100%;
          498  +      border: 3px groove #444444;
          499  +    }
   427    500   
   428    501       .warning {
   429    502         text-align:center;
   430    503         color: red;
   431    504         font-size: 2em;
   432    505         font-weight: bold;
   433    506       }
   434    507   
   435         -    .right {
   436         -    }
   437         -
   438    508       .testfield {
   439    509         padding-right: 10ex;
          510  +      white-space: nowrap;
   440    511       }
   441    512   
   442    513       .testwait {}
   443    514       .testrunning { color: blue }
   444    515       .testdone { color: green }
   445    516       .testfail { color: red }
          517  +
          518  +    .right { float: right; }
          519  +
   446    520     }
   447    521   }
   448    522   
   449         -proc wapp-page-script.js {} {
          523  +# URI: /script/${state}.js
          524  +#
          525  +# The last part of this URI is always "config.js", "running.js" or 
          526  +# "stopped.js", depending on the state of the application. It returns
          527  +# the javascript part of the front-end for the requested state to the
          528  +# browser.
          529  +#
          530  +proc wapp-page-script {} {
          531  +  regexp {[^/]*$} [wapp-param REQUEST_URI] script
   450    532   
   451    533     set tcl $::G(tcl)
   452    534     set keep $::G(keep)
   453    535     set msvc $::G(msvc)
   454    536     
   455    537     wapp-subst {
   456         -    var lElem = \["control_platform", "control_test", "control_msvc", "control_jobs"\];
          538  +    var lElem = \["control_platform", "control_test", "control_msvc", 
          539  +        "control_jobs"
          540  +    \];
   457    541       lElem.forEach(function(e) {
   458    542         var elem = document.getElementById(e);
   459    543         elem.addEventListener("change", function() { control.submit() } );
   460    544       })
   461    545   
   462    546       elem = document.getElementById("control_tcl");
   463    547       elem.value = "%string($tcl)"
................................................................................
   465    549       elem = document.getElementById("control_keep");
   466    550       elem.checked = %string($keep);
   467    551   
   468    552       elem = document.getElementById("control_msvc");
   469    553       elem.checked = %string($msvc);
   470    554     }
   471    555   
   472         -  if {$::G(state)!="config"} {
          556  +  if {$script != "config.js"} {
   473    557       wapp-subst {
   474    558         var lElem = \["control_platform", "control_test", 
   475         -          "control_tcl", "control_keep", "control_msvc", "control_go"
          559  +          "control_tcl", "control_keep", "control_msvc"
   476    560         \];
   477    561         lElem.forEach(function(e) {
   478    562           var elem = document.getElementById(e);
   479    563           elem.disabled = true;
   480    564         })
   481    565       }
   482    566     }
          567  +
          568  +  if {$script == "running.js"} {
          569  +    wapp-subst {
          570  +      function reload_tests() {
          571  +        fetch('tests')
          572  +          .then( data => data.text() )
          573  +          .then( data => {
          574  +            document.getElementById("tests").innerHTML = data;
          575  +          })
          576  +          .then( data => {
          577  +            if( document.getElementById("result") ){
          578  +              document.location = document.location;
          579  +            } else {
          580  +              setTimeout(reload_tests, 1000)
          581  +            }
          582  +          });
          583  +      }
          584  +
          585  +      setTimeout(reload_tests, 1000)
          586  +    }
          587  +  }
   483    588   }
   484    589   
          590  +# URI: /env
          591  +#
          592  +# This is for debugging only. Serves no other purpose.
          593  +#
   485    594   proc wapp-page-env {} {
   486    595     wapp-allow-xorigin-params
   487    596     wapp-trim {
   488    597       <h1>Wapp Environment</h1>\n<pre>
   489    598       <pre>%html([wapp-debug-env])</pre>
   490    599     }
   491    600   }
   492    601   
          602  +# URI: /log/dirname/test.log
          603  +#
          604  +# This URI reads file "dirname/test.log" from disk, wraps it in a <pre>
          605  +# block, and returns it to the browser. Use for viewing log files.
          606  +#
   493    607   proc wapp-page-log {} {
   494    608     set log [string range [wapp-param REQUEST_URI] 5 end]
   495    609     set fd [open $log]
   496    610     set data [read $fd]
   497    611     close $fd
   498    612     wapp-trim {
   499    613       <pre>
   500    614       %html($data)
   501    615       </pre>
   502    616     }
   503    617   }
   504    618   
          619  +wapptest_init
   505    620   wapp-start $argv
   506    621