Documentation Source Text

Artifact Content
Login

Artifact 8eaf49b3a206400b4930ca46d2b49c5bcc745fc5192a241d7f7e1a3562ecdc31:


#
# 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
}