#
# This is TCL library for uploading a test outcome to the testing dashboard.
# Test scripts can "source" this library and then invoke its methods in order
# to report test success and/or failure to the dashboard.
#
# Requirements:
#
# * SQLite needs to be loaded into the TCL interpreter
#
# * A recent "fossil" command needs to be available to "exec".
#
# * A platform configuration file needs to be configured. The
# platform configuration is a file named "./dashconfig" or
# "~/.dashconfig" (searched in that order) that is a single
# line of two fields, the URL of the dashboard server and the
# platform code.
#
# Usage:
#
# The test script must invoke "dashboard-init" exactly once in order
# to initialize the uplink library.
#
# Each test scenario run by the script must be given its own name.
# Call it $testName. For each test scenario, the script must run:
#
# dashboard-config $testName $key1 $value1 $key2 $value2 ...
#
# The dashboard-config command can be run multiple times. Duplicate
# keys silently overwrite. The following keys are supported:
#
# srchash (REQUIRED) The SHA3 hash of the SQLite version under test
#
# srcdate (REQUIRED) Dates of the SQLite version under test in the
# ISO8601 format: "YYYY-MM-DD HH:MM:SS"
#
# branch (REQUIRED) The branch from which srchash is taken
#
# toolhash (optional) SHA3 hash of the system doing the testing
#
# tooldate (optional) ISO8601 date corresponding to toolhash
#
# elapsetm (optional) Number of seconds for which the test ran
#
# expire (optional) This report should expire after this many
# seconds. Used for "running" reports to indicate that
# the script expects to update the report later.
#
# report (optional) Output from the test run. This should be
# abbreviated to show the final test results, or perhaps
# some error diagnostics in the event of a failure. While
# very large reports are accepted, it is best to keep them
# small by removing extraneous text prior to upload.
#
# testcase (optional) The testcase that provoked a failure in
# a fuzz-testing scenario
#
# Note in particular that srchash and srcdate must be set!
#
# After the scenario is configured, invoke one of the following to upload
# the report to the dashboard:
#
# dashboard-running $testName
# dashboard-pass $testName
# dashboard-fail $testName
#
# The dashboard-running command can be invoked multiple times. After
# dashboard-pass or dashboard-fail, however, the scenario is finish and
# cannot be reused without reconfiguring it from scratch.
#
proc dashboard-init {} {
upvar #0 dashboard-global G
set miss {}
foreach x {./dashconfig ~/.dashconfig} {
set x [file normalize $x]
if {[file readable $x]} {
set fd [open $x rb]
foreach {url platformId} [read $fd] break
close $fd
break
} else {
lappend miss $x
}
}
if {![info exists url]} {
return "cannot find the dashboard upload configuration any of: $miss"
}
if {[catch {package require sqlite3}]} {
return "cannot load the sqlite3 package"
}
set G(url) $url
set G(platformId) $platformId
set G(trace) 0
package require sqlite3
sqlite3 dashboard-db :memory:
dashboard-db eval {PRAGMA page_size=512}
dashboard-db eval {CREATE TABLE up(k,v)}
return {}
}
proc dashboard-remote {} {
upvar #0 dashboard-global G
if {[info exists G(url)]} {return $G(url)}
return {}
}
proc dashboard-uuid {} {
return [dashboard-db eval {SELECT lower(hex(randomblob(20)))}]
}
proc dashboard-config {name args} {
upvar #0 dashboard-data-$name D dashboard-global G
if {![info exists G(url)]} return
foreach {key value} $args {
set D($key) $value
}
if {![info exists D(testId)]} {
set D(testId) [dashboard-uuid]
}
}
proc dashboard-unconfig {name} {
upvar #0 dashboard-data-$name D
unset -nocomplain D
}
proc dashboard-trace {bool} {
upvar #0 dashboard-global G
set G(trace) $bool
}
proc dashboard-send {name} {
upvar #0 dashboard-data-$name D dashboard-global G
if {![info exists G(url)]} return
if {![info exists D]} {
error "no such testcase: $name"
}
if {$G(trace)} {
puts "DASHBOARD-TRACE: send $name"
}
dashboard-db eval {DELETE FROM up}
set D(platformId) $G(platformId)
set D(testName) $name
foreach key [array names D] {
set val $D($key)
dashboard-db eval {INSERT INTO up VALUES($key,$val)}
}
set uid [dashboard-uuid]
set fup dashboard-uplink-$uid.db
set fdown dashboard-downlink-$uid.txt
dashboard-db eval {VACUUM}
dashboard-db backup $fup
dashboard-db eval {DELETE FROM up}
set cmd "exec fossil test-httpmsg $G(url)/upload $fup \
--mimetype application/x-sqlite >$fdown"
set rc [catch $cmd msg]
if {$G(trace)} {
puts "DASHBOARD-TRACE: $cmd"
if {$rc} {
puts "DASHBOARD-TRACE: upload failed: $msg"
}
}
if {$rc} {
puts stderr "dashboard uplink to $G(url) failed"
puts stderr "error-message: \"$msg\""
puts stderr "uplink-command: $cmd"
} else {
file delete $fup
file delete $fdown
}
}
proc dashboard-running {name} {
dashboard-config $name status running
dashboard-send $name
}
proc dashboard-pass {name} {
dashboard-config $name status pass
dashboard-send $name
dashboard-unconfig $name
}
proc dashboard-fail {name} {
dashboard-config $name status fail
dashboard-send $name
dashboard-unconfig $name
}