#! /usr/bin/env tclsh
package require Tcl 8.5
set WEBDIR "/web/rkeene/devel/kitcreator/kitbuild"
if {[llength $argv] != 1} {
puts stderr "Usage: publish-tests <version>"
exit 1
}
set kitcreator_vers [lindex $argv 0]
if {$kitcreator_vers == ""} {
puts stderr "Invalid version: \"$kitcreator_vers\""
exit 1
}
set WEBDIR [file join $WEBDIR $kitcreator_vers]
if {![file isdir "kits"]} {
puts stderr "Could not find kits/ directory, aborting."
exit 1
}
# Define non-critical tests
set noncriticaltests [list "05-locale"]
# Define legend
set statusdata(ok) [list OK green "Software built successfully and passed all tests"]
set statusdata(untested) [list "NO TESTS" yellow "Software built successfully but no tests were run"]
set statusdata(non-critical) [list "USABLE" orange "Software built successfully and all tests were run, but some non-critical tests failed"]
set statusdata(failed) [list "FAILED" red "Some critical tests failed or the software did not build"]
##########################################################################
## PROCEDURES ############################################################
##########################################################################
proc pretty_print_key {key} {
set version [lindex $key 0]
set os [lindex $key 1]
set cpu [lindex $key 2]
switch -glob -- $version {
"cvs_HEAD" {
set version "from CVS HEAD"
}
"cvs_*" {
set tag [join [lrange [split $version _] 1 end] _]
set version "from CVS tag $tag"
}
default {
set version "version $version"
}
}
return "Tcl $version for [string totitle $os] on $cpu"
}
proc pretty_print_buildinfo {buildinfo} {
set desc [list]
foreach tag [list kitdll min static notk nomk4 statictk unthreaded threaded zip] {
if {[lsearch -exact $buildinfo $tag] != -1} {
switch -- $tag {
"kitdll" {
lappend desc "Built as a Library"
}
"min" {
lappend desc "Minimally Built"
}
"static" {
lappend desc "Statically Linked"
}
"notk" {
lappend desc "Without Tk"
}
"nomk4" {
lappend desc "Without Metakit4"
}
"statictk" {
lappend desc "Tk linked to Kit"
}
"threaded" {
lappend desc "Threaded"
}
"unthreaded" {
lappend desc "Without Threads"
}
"zip" {
lappend desc "Kit Filesystem in Zip"
}
}
}
}
if {[llength $desc] == 0} {
return "Default Build"
}
return [join $desc {, }]
}
proc pretty_print_size {size} {
foreach unit [list "" K M G T P] {
if {$size < 1024} {
if {$size < 10 && $unit != ""} {
set size [expr {round($size * 10) / 10.0}]
} else {
set size [expr {round($size)}]
}
return "$size [string trim ${unit}B]"
}
set size [expr {${size} / 1024.000}]
}
}
##########################################################################
## MAIN BODY #############################################################
##########################################################################
file delete -force -- $WEBDIR
file mkdir $WEBDIR
set fd [open [file join $WEBDIR index.html] w]
file copy -force -- {*}[glob kits/*] $WEBDIR
set totaltests_count [llength [glob tests/*.tcl]]
foreach file [lsort -dictionary [glob -tails -directory $WEBDIR * failed/*]] {
set shortfile $file
set file [file join $WEBDIR $file]
if {[file isdirectory $file]} {
continue
}
switch -glob -- $file {
"*.log" - "*.ttml" - "*.html" - "*.desc" - "*-origname" - "*-tclsh" {
continue
}
}
# Derive what we can from the filename
set buildfile "${shortfile}-build.log"
# Determine which tests passed/failed
set failedtests [list]
set passedtests [list]
set testsfile "${file}-tests.log"
if {[file exists $testsfile]} {
set testfd [open $testsfile r]
foreach line [split [read $testfd] \n] {
set work [split $line :]
set test [string trim [lindex $work 0]]
set result [string trim [lindex $work 1]]
switch -- $result {
"PASS" {
lappend passedtests "${shortfile}-${test}.log"
}
"FAIL" {
lappend failedtests "${shortfile}-${test}.log"
}
}
}
close $testfd
}
# If this kit represents a failed build, set the failed tests to that
set kitbuilt 1
if {[file tail [file dirname $file]] == "failed"} {
set failedtests [list "${shortfile}-XX-build.log"]
set passedtests [list]
set kitbuilt 0
}
## Split the filename into parts and store each part
unset -nocomplain kitos kitcpu
set kitbuildinfo [split $shortfile -]
set tclversion [lindex $kitbuildinfo 1]
set kitos [lindex $kitbuildinfo 2]
set kitcpu [lindex $kitbuildinfo 3]
### Store the remainder as a list of tags
set kitbuildinfo [lsort -dictionary [lrange $kitbuildinfo 4 end]]
# Generate array to describe this kit
unset -nocomplain kitinfo
set kitinfo(version) $tclversion
set kitinfo(file) $shortfile
set kitinfo(fullfile) $file
set kitinfo(buildfile) $buildfile
set kitinfo(failedtests) $failedtests
set kitinfo(passedtests) $passedtests
set kitinfo(buildflags) $kitbuildinfo
set kitinfo(os) $kitos
set kitinfo(cpu) $kitcpu
set kitinfo(built) $kitbuilt
# Store kit information with all kits
set key [list $tclversion $kitos $kitcpu]
lappend allkitinfo($key) [array get kitinfo]
}
# Determine human readable name, and URL
if {[string match "fossil_*" $kitcreator_vers]} {
set work [split $kitcreator_vers _]
set kitcreator_fossil_vers [lindex $work 1]
set kitcreator_readable_vers "Fossil trunk check-in ${kitcreator_fossil_vers}"
set url "http://kitcreator.rkeene.org/fossil/tarball/kitcreator-${kitcreator_vers}.tar.gz?uuid=${kitcreator_fossil_vers}"
} else {
set kitcreator_readable_vers $kitcreator_vers
set url "http://www.rkeene.org/devel/kitcreator-${kitcreator_vers}.tar.gz"
}
puts $fd "<html>"
puts $fd " <head>"
puts $fd " <title>KitCreator Build and Test Status</title>"
puts $fd " </head>"
puts $fd " <body>"
puts $fd " <h1><a href=\"http://kitcreator.rkeene.org/\">KitCreator</a> <a href=\"../\">Build and Test Status</a></h1>"
puts $fd " <p>The following table represents the status of the test results from the KitCreator test suite for <a href=\"${url}\">KitCreator ${kitcreator_readable_vers}</a>.</p>"
puts $fd " <table cellpadding=\"2\" border=\"1\">"
foreach key [lsort -dictionary [array names allkitinfo]] {
puts $fd " <tr>"
puts $fd " <th colspan=\"5\"><u>Tclkit for [pretty_print_key $key]</u></th>"
puts $fd " </tr>"
puts $fd " <tr>"
puts $fd " <th>Kit Features</th>"
puts $fd " <th>Kit Size</th>"
puts $fd " <th>Status</th>"
puts $fd " <th>Log</th>"
puts $fd " <th>Failed Tests</th>"
puts $fd " </tr>"
foreach kitinfo_list $allkitinfo($key) {
puts $fd " <tr>"
unset -nocomplain kitinfo
array set kitinfo $kitinfo_list
if {[llength $kitinfo(failedtests)] == 0} {
set status ok
# If we are cross-compiled, note that no tests were run
if {[llength $kitinfo(passedtests)] == 0} {
set status untested
}
} else {
set status non-critical
}
set failedtestshtml [list]
foreach test [lsort -dictionary $kitinfo(failedtests)] {
set testname [file rootname $test]
set testname [split $testname -]
for {set idx 0} {$idx < [llength $testname]} {incr idx} {
set val [lindex $testname $idx]
if {[string match {[0-9X][0-9X]} $val]} {
set testname [join [lrange $testname $idx end] -]
set loglink 1
if {[lindex [split $testname -] 0] == "XX"} {
set testname [join [lrange [split $testname -] 1 end] -]
set loglink 0
}
break
}
}
if {[lsearch -exact $noncriticaltests $testname] == -1} {
set status failed
}
if {$loglink} {
lappend failedtestshtml "<small><a href=\"$test\">$testname</a></small>"
} else {
lappend failedtestshtml "<small>$testname</small>"
}
}
set statusinfo $statusdata($status)
set statustext [lindex $statusinfo 0]
set bgcolor [lindex $statusinfo 1]
set kitdesc [pretty_print_buildinfo $kitinfo(buildflags)]
if {$kitinfo(built)} {
puts $fd " <td><a href=\"$kitinfo(file)\">$kitdesc</a></td>"
} else {
puts $fd " <td>$kitdesc</td>"
}
puts $fd " <td>[pretty_print_size [file size [file join $WEBDIR $kitinfo(fullfile)]]]</td>"
puts $fd " <td bgcolor=\"$bgcolor\">$statustext</td>"
puts $fd " <td><small><a href=\"$kitinfo(buildfile)\">([pretty_print_size [file size [file join $WEBDIR $kitinfo(buildfile)]]])</a></small></td>"
puts $fd " <td>[join $failedtestshtml {,<br>}]</td>"
puts $fd " </tr>"
}
}
puts $fd " </table>"
puts $fd " <table cellpadding=\"2\" border=\"1\">"
puts $fd " <tr>"
puts $fd " <th colspan=\"2\"><small>Legend</small></th>"
puts $fd " </tr>"
foreach status [list ok untested non-critical failed] {
set statusinfo $statusdata($status)
set statustext [lindex $statusinfo 0]
set bgcolor [lindex $statusinfo 1]
set statusdetail [lindex $statusinfo 2]
puts $fd " <tr>"
puts $fd " <td bgcolor=\"$bgcolor\"><small>$statustext</small></td>"
puts $fd " <td><small>$statusdetail</small></td>"
puts $fd " </tr>"
}
puts $fd " </table>"
puts $fd " <p>Generated on [clock format [clock seconds]]</p>"
puts $fd " </body>"
puts $fd "</html>"
close $fd