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

Changes to test/wapptest.tcl.

    17     17   #   G(msvc)     - Boolean. True to use MSVC as the compiler.
    18     18   #   G(tcl)      - Use Tcl from this directory for builds.
    19     19   #   G(jobs)     - How many sub-processes to run simultaneously.
    20     20   #
    21     21   set G(platform) $::tcl_platform(os)-$::tcl_platform(machine)
    22     22   set G(test)     Normal
    23     23   set G(keep)     1
    24         -set G(msvc)     [expr {$::tcl_platform(platform)=="windows"}]
           24  +set G(msvc)     0
    25     25   set G(tcl)      [::tcl::pkgconfig get libdir,install]
    26     26   set G(jobs)     3
    27     27   set G(debug)    0
           28  +
           29  +set G(noui)     0
           30  +set G(stdout)   0
           31  +
    28     32   
    29     33   proc wapptest_init {} {
    30     34     global G
    31     35   
    32         -  set lSave [list platform test keep msvc tcl jobs debug] 
           36  +  set lSave [list platform test keep msvc tcl jobs debug noui stdout] 
    33     37     foreach k $lSave { set A($k) $G($k) }
    34     38     array unset G
    35     39     foreach k $lSave { set G($k) $A($k) }
    36     40   
    37     41     # The root of the SQLite source tree.
    38     42     set G(srcdir)   [file dirname [file dirname [info script]]]
    39     43   
................................................................................
    44     48   
    45     49     set G(hostname) "(unknown host)"
    46     50     catch { set G(hostname) [exec hostname] } 
    47     51     set G(host) $G(hostname)
    48     52     append G(host) " $::tcl_platform(os) $::tcl_platform(osVersion)"
    49     53     append G(host) " $::tcl_platform(machine) $::tcl_platform(byteOrder)"
    50     54   }
           55  +
           56  +proc wapptest_run {} {
           57  +  global G
           58  +  set_test_array
           59  +  set G(state) "running"
           60  +
           61  +  wapptest_openlog
           62  +
           63  +  wapptest_output "Running the following for $G(platform). $G(jobs) jobs."
           64  +  foreach t $G(test_array) {
           65  +    set config [dict get $t config]
           66  +    set target [dict get $t target]
           67  +    wapptest_output [format "    %-25s%s" $config $target]
           68  +  }
           69  +  wapptest_output [string repeat * 70]
           70  +}
    51     71   
    52     72   # Generate the text for the box at the top of the UI. The current SQLite
    53     73   # version, according to fossil, along with a warning if there are 
    54     74   # uncommitted changes in the checkout.
    55     75   #
    56     76   proc generate_fossil_info {} {
    57     77     global G
................................................................................
   192    212     } elseif {!$seen} {
   193    213       set G(test.$name.errmsg) "Test did not complete"
   194    214       if {[file readable core]} {
   195    215         append G(test.$name.errmsg) " - core file exists"
   196    216       }
   197    217     }
   198    218   }
          219  +
          220  +proc wapptest_output {str} {
          221  +  global G
          222  +  if {$G(stdout)} { puts $str }
          223  +  if {[info exists G(log)]} { 
          224  +    puts $G(log) $str 
          225  +    flush $G(log)
          226  +  }
          227  +}
          228  +proc wapptest_openlog {} {
          229  +  global G
          230  +  set G(log) [open wapptest-out.txt w+]
          231  +}
          232  +proc wapptest_closelog {} {
          233  +  global G
          234  +  close $G(log)
          235  +  unset G(log)
          236  +}
          237  +
          238  +proc format_seconds {seconds} {
          239  +  set min [format %.2d [expr ($seconds / 60) % 60]]
          240  +  set  hr [format %.2d [expr $seconds / 3600]]
          241  +  set sec [format %.2d [expr $seconds % 60]]
          242  +  return "$hr:$min:$sec"
          243  +}
   199    244   
   200    245   # This command is invoked once a slave process has finished running its
   201    246   # tests, successfully or otherwise. Parameter $name is the name of the 
   202    247   # test, $rc the exit code returned by the slave process.
   203    248   #
   204    249   proc slave_test_done {name rc} {
   205    250     global G
................................................................................
   229    274       foreach f [glob -nocomplain [file join $G(test.$name.dir) *]] {
   230    275         set t [file tail $f]
   231    276         if {[lsearch $keeplist $t]<0} {
   232    277           catch { file delete -force $f }
   233    278         }
   234    279       }
   235    280     }
          281  +
          282  +  # Format a message regarding the success or failure of hte test.
          283  +  set t [format_seconds [expr $G(test.$name.done) - $G(test.$name.start)]]
          284  +  set res "OK"
          285  +  if {$G(test.$name.nError)} { set res "FAILED" }
          286  +  set dots [string repeat . [expr 60 - [string length $name]]]
          287  +  set msg "$name $dots $res ($t)"
          288  +
          289  +  wapptest_output $msg
          290  +  if {[info exists G(test.$name.errmsg)] && $G(test.$name.errmsg)!=""} {
          291  +    wapptest_output "    $G(test.$config.errmsg)"
          292  +  }
   236    293   }
   237    294   
   238    295   # This is a fileevent callback invoked each time a file-descriptor that
   239    296   # connects this process to a slave process is readable.
   240    297   #
   241    298   proc slave_fileevent {name} {
   242    299     global G
................................................................................
   368    425       foreach j $G(test_array) {
   369    426         set name [dict get $j config]
   370    427         incr nError $G(test.$name.nError)
   371    428         incr nTest $G(test.$name.nTest)
   372    429         incr nConfig 
   373    430       }
   374    431       set G(result) "$nError errors from $nTest tests in $nConfig configurations."
          432  +    wapptest_output [string repeat * 70]
          433  +    wapptest_output $G(result)
   375    434       catch {
   376    435         append G(result) " SQLite version $G(sqlite_version)"
          436  +      wapptest_output " SQLite version $G(sqlite_version)"
   377    437       }
   378    438       set G(state) "stopped"
          439  +    wapptest_closelog
          440  +    if {$G(noui)} { exit 0 }
   379    441     } else {
   380    442       set nLaunch [expr $G(jobs) - $nRunning]
   381    443       foreach j $G(test_array) {
   382    444         if {$nLaunch<=0} break
   383    445         set name [dict get $j config]
   384    446         if { ![info exists G(test.$name.channel)]
   385    447           && ![info exists G(test.$name.done)]
................................................................................
   539    601           if {$G(test.$config.nError)>0} {
   540    602             set class "testfail" 
   541    603           } else {
   542    604             set class "testdone"
   543    605           }
   544    606           set seconds [expr $G(test.$config.done) - $G(test.$config.start)]
   545    607         }
   546         -
   547         -      set min [format %.2d [expr ($seconds / 60) % 60]]
   548         -      set  hr [format %.2d [expr $seconds / 3600]]
   549         -      set sec [format %.2d [expr $seconds % 60]]
   550         -      set seconds "$hr:$min:$sec"
          608  +      set seconds [format_seconds $seconds]
   551    609       }
   552    610   
   553    611       wapp-trim {
   554    612         <tr class=%string($class)>
   555    613         <td class="nowrap"> %html($config) 
   556    614         <td class="padleft nowrap"> %html($target)
   557    615         <td class="padleft nowrap"> %html($seconds)
................................................................................
   602    660       if {[wapp-param-exists control_$v]} {
   603    661         set G($v) [wapp-param control_$v]
   604    662       }
   605    663     }
   606    664   
   607    665     if {[wapp-param-exists control_run]} {
   608    666       # This is a "run test" command.
   609         -    set_test_array
   610         -    set ::G(state) "running"
          667  +    wapptest_run
   611    668     }
   612    669   
   613    670     if {[wapp-param-exists control_stop]} {
   614    671       # A "STOP tests" command.
   615    672       set G(state) "stopped"
   616    673       set G(result) "Test halted by user"
   617    674       foreach j $G(test_array) {
................................................................................
   618    675         set name [dict get $j config]
   619    676         if { [info exists G(test.$name.channel)] } {
   620    677           close $G(test.$name.channel)
   621    678           unset G(test.$name.channel)
   622    679           slave_test_done $name 1
   623    680         }
   624    681       }
          682  +    wapptest_closelog
   625    683     }
   626    684   
   627    685     if {[wapp-param-exists control_reset]} {
   628    686       # A "reset app" command.
   629    687       set G(state) "config"
   630    688       wapptest_init
   631    689     }
................................................................................
   768    826     close $fd
   769    827     wapp-trim {
   770    828       <pre>
   771    829       %html($data)
   772    830       </pre>
   773    831     }
   774    832   }
          833  +
          834  +# Print out a usage message. Then do [exit 1].
          835  +#
          836  +proc wapptest_usage {} {
          837  +  puts stderr {
          838  +This Tcl script is used to test various configurations of SQLite. By
          839  +default it uses "wapp" to provide an interactive interface. Supported 
          840  +command line options (all optional) are:
          841  +
          842  +    --platform    PLATFORM         (which tests to run)
          843  +    --smoketest                    (run "make smoketest" only)
          844  +    --veryquick                    (run veryquick.test only)
          845  +    --buildonly                    (build executables, do not run tests)
          846  +    --jobs        N                (number of concurrent jobs)
          847  +    --tcl         DIR              (where to find tclConfig.sh)
          848  +    --deletefiles                  (delete extra files after each test)
          849  +    --msvc                         (Use MS Visual C)
          850  +    --debug                        (Also run [n]debugging versions of tests)
          851  +    --noui                         (do not use wapp)
          852  +  }
          853  +  exit 1
          854  +}
          855  +
          856  +# Sort command line arguments into two groups: those that belong to wapp,
          857  +# and those that belong to the application.
          858  +set WAPPARG(-server)      1
          859  +set WAPPARG(-local)       1
          860  +set WAPPARG(-scgi)        1
          861  +set WAPPARG(-remote-scgi) 1
          862  +set WAPPARG(-fromip)      1
          863  +set WAPPARG(-nowait)      0
          864  +set WAPPARG(-cgi)         0
          865  +set lWappArg [list]
          866  +set lTestArg [list]
          867  +for {set i 0} {$i < [llength $argv]} {incr i} {
          868  +  set arg [lindex $argv $i]
          869  +  if {[string range $arg 0 1]=="--"} {
          870  +    set arg [string range $arg 1 end]
          871  +  }
          872  +  if {[info exists WAPPARG($arg)]} {
          873  +    lappend lWappArg $arg
          874  +    if {$WAPPARG($arg)} {
          875  +      incr i
          876  +      lappend lWappArg [lindex $argv $i]
          877  +    }
          878  +  } else {
          879  +    lappend lTestArg $arg
          880  +  }
          881  +}
          882  +
          883  +for {set i 0} {$i < [llength $lTestArg]} {incr i} {
          884  +  switch -- [lindex $lTestArg $i] {
          885  +    -platform {
          886  +      if {$i==[llength $lTestArg]-1} { wapptest_usage }
          887  +      incr i
          888  +      set arg [lindex $lTestArg $i]
          889  +      set lPlatform [array names ::Platforms]
          890  +      if {[lsearch $lPlatform $arg]<0} {
          891  +        puts stderr "No such platform: $arg. Platforms are: $lPlatform"
          892  +        exit -1
          893  +      }
          894  +      set G(platform) $arg
          895  +    }
          896  +
          897  +    -smoketest { set G(test) Smoketest }
          898  +    -veryquick { set G(test) Veryquick }
          899  +    -buildonly { set G(test) Build-Only }
          900  +    -jobs {
          901  +      if {$i==[llength $lTestArg]-1} { wapptest_usage }
          902  +      incr i
          903  +      set G(jobs) [lindex $lTestArg $i]
          904  +    }
          905  +
          906  +    -tcl {
          907  +      if {$i==[llength $lTestArg]-1} { wapptest_usage }
          908  +      incr i
          909  +      set G(tcl) [lindex $lTestArg $i]
          910  +    }
          911  +
          912  +    -deletefiles {
          913  +      set G(keep) 0
          914  +    }
          915  +
          916  +    -msvc {
          917  +      set G(msvc) 1
          918  +    }
          919  +
          920  +    -debug {
          921  +      set G(debug) 1
          922  +    }
          923  +
          924  +    -noui {
          925  +      set G(noui) 1
          926  +      set G(stdout) 1
          927  +    }
          928  +
          929  +    -stdout {
          930  +      set G(stdout) 1
          931  +    }
          932  +
          933  +    default {
          934  +      puts stderr "Unrecognized option: [lindex $lTestArg $i]"
          935  +      wapptest_usage
          936  +    }
          937  +  }
          938  +}
   775    939   
   776    940   wapptest_init
   777         -wapp-start $argv
          941  +if {$G(noui)==0} {
          942  +  wapp-start $lWappArg
          943  +} else {
          944  +  wapptest_run
          945  +  do_some_stuff
          946  +  vwait forever
          947  +}
   778    948