Index: test/wapptest.tcl ================================================================== --- test/wapptest.tcl +++ test/wapptest.tcl @@ -1,12 +1,15 @@ #!/bin/sh # \ exec wapptclsh "$0" ${1+"$@"} -# +# package required wapp +source [file join [file dirname [info script]] wapp.tcl] + +# Read the data from the releasetest_data.tcl script. # -# +source [file join [file dirname [info script]] releasetest_data.tcl] # Variables set by the "control" form: # # G(platform) - User selected platform. # G(test) - Set to "Normal", "Veryquick", "Smoketest" or "Build-Only". @@ -20,32 +23,29 @@ set G(keep) 0 set G(msvc) 0 set G(tcl) "" set G(jobs) 3 -set G(sqlite_version) unknown - -# The root of the SQLite source tree. -# -set G(srcdir) [file dirname [file dirname [info script]]] - -# Either "config", "running", "stopped": -# -set G(state) "config" - -# releasetest.tcl script -# -set G(releaseTest) [file join [file dirname [info script]] releasetest.tcl] - -set G(cnt) 0 - -# package required wapp -source [file join [file dirname [info script]] wapp.tcl] - -# Read the data from the releasetest_data.tcl script. -# -source [file join [file dirname [info script]] releasetest_data.tcl] +proc wapptest_init {} { + global G + + set lSave [list platform test keep msvc tcl jobs] + foreach k $lSave { set A($k) $G($k) } + array unset G + foreach k $lSave { set G($k) $A($k) } + + # The root of the SQLite source tree. + set G(srcdir) [file dirname [file dirname [info script]]] + + # releasetest.tcl script + set G(releaseTest) [file join [file dirname [info script]] releasetest.tcl] + + set G(sqlite_version) "unknown" + + # Either "config", "running" or "stopped": + set G(state) "config" +} # Check to see if there are uncommitted changes in the SQLite source # directory. Return true if there are, or false otherwise. # proc check_uncommitted {} { @@ -159,29 +159,34 @@ if {[file readable core]} { append G(test.$name.errmsg) " - core file exists" } } } + +proc slave_test_done {name rc} { + global G + set G(test.$name.done) [clock seconds] + set G(test.$name.nError) 0 + set G(test.$name.nTest) 0 + set G(test.$name.errmsg) "" + if {$rc} { + incr G(test.$name.nError) + } + if {[file exists $G(test.$name.log)]} { + count_tests_and_errors $name $G(test.$name.log) + } +} proc slave_fileevent {name} { global G set fd $G(test.$name.channel) if {[eof $fd]} { fconfigure $fd -blocking 1 set rc [catch { close $fd }] unset G(test.$name.channel) - set G(test.$name.done) [clock seconds] - set G(test.$name.nError) 0 - set G(test.$name.nTest) 0 - set G(test.$name.errmsg) "" - if {$rc} { - incr G(test.$name.nError) - } - if {[file exists $G(test.$name.log)]} { - count_tests_and_errors $name $G(test.$name.log) - } + slave_test_done $name $rc } else { set line [gets $fd] if {[string trim $line] != ""} { puts "Trace : $name - \"$line\"" } } @@ -213,10 +218,11 @@ } set G(result) "$nError errors from $nTest tests in $nConfig configurations." catch { append G(result) " SQLite version $G(sqlite_version)" } + set G(state) "stopped" } else { set nLaunch [expr $G(jobs) - $nRunning] foreach j $G(test_array) { if {$nLaunch<=0} break set name [dict get $j config] @@ -238,15 +244,29 @@ incr nLaunch -1 } } } } + +proc generate_select_widget {label id lOpt opt} { + wapp-trim { + + } +} proc generate_main_page {{extra {}}} { global G set_test_array + # wapp-trim {
@@ -263,66 +283,81 @@ } } wapp-trim {