KitCreator
Artifact [a10ea41136]
Login
HomeDownloadsSource CodeTicketsWiki
Check-ins Using Download Hex

Artifact a10ea41136f77910c14e54b929f6346b7fa5ec49:

#! /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 min static notk statictk unthreaded threaded zip] {
		if {[lsearch -exact $buildinfo $tag] != -1} {
			switch -- $tag {
				"min" {
					lappend desc "Minimally Built"
				}
				"static" {
					lappend desc "Statically Linked"
				}
				"notk" {
					lappend desc "Without Tk"
				}
				"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" {
			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]
}

puts $fd "<html>"
puts $fd "  <head>"
puts $fd "    <title>KitCreator Build and Test Status</title>"
puts $fd "  </head>"
puts $fd "  <body>"
puts $fd "    <h1>KitCreator Build and Test Status</h1>"
puts $fd "    <p>The following table represents the status of the test results from the KitCreator test suite.</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 {, }]</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
Powered by Fossil · RSS