Use: testgrid [group [grid]] [options...]
Allowed options are:
-parallel N: run N parallel processes (default is number of CPUs, 0 to disable)
- -refresh N: save summary logs every N seconds (default 60, minimal 1, 0 to disable)
+ -refresh N: save summary logs every N seconds (default 600, minimal 1, 0 to disable)
-outdir dirname: set log directory (should be empty or non-existing)
-overwrite: force writing logs in existing non-empty directory
-xml filename: write XML report for Jenkins (in JUnit-like format)
######################################################
# log command arguments and environment
- set log "Command: testgrid $args\nHost: [info hostname]\nStarted on: [clock format [clock seconds] -format {%Y-%m-%d %H:%M:%S}]\n"
- catch {set log "$log\nDRAW build:\n[dversion]\n" }
- set log "$log\nEnvironment:\n"
+ lappend log "Command: testgrid $args"
+ lappend log "Host: [info hostname]"
+ lappend log "Started on: [clock format [clock seconds] -format {%Y-%m-%d %H:%M:%S}]"
+ catch {lappend log "DRAW build:\n[dversion]" }
+ lappend log "Environment:"
foreach envar [lsort [array names env]] {
- set log "$log$envar=\"$env($envar)\"\n"
+ lappend log "$envar=\"$env($envar)\""
}
- set log "$log\n"
+ lappend log ""
set refresh_timer [clock seconds]
uplevel dchrono _timer reset
# of starting / processing jobs by running threads
catch {tpool::suspend $worker}
if { $_tests_verbose > 0 } { _log_and_puts log "Executing tests in (up to) $parallel threads" }
+ # limit number of jobs in the queue by reasonable value
+ # to prevent slowdown due to unnecessary queue processing
+ set nbpooled 0
+ set nbpooled_max [expr 10 * $parallel]
+ set nbpooled_ok [expr 5 * $parallel]
}
}
set userbreak 0
foreach test_def $tests_list {
# check for user break
- if { "[info commands dbreak]" == "dbreak" && [catch dbreak] } {
+ if { $userbreak || "[info commands dbreak]" == "dbreak" && [catch dbreak] } {
set userbreak 1
break
}
# parallel execution
set job [tpool::post -nowait $worker "catch \"$command\" output; return \$output"]
set job_def($job) [list $logdir $dir $group $grid $casename]
+ incr nbpooled
+ if { $nbpooled > $nbpooled_max } {
+ _testgrid_process_jobs $worker $nbpooled_ok
+ }
} else {
# sequential execution
catch {eval $command} output
# get results of started threads
if { $parallel > 0 } {
- catch {tpool::resume $worker}
- while { ! $userbreak && [llength [array names job_def]] > 0 } {
- foreach job [tpool::wait $worker [array names job_def]] {
- eval _log_test_case \[tpool::get $worker $job\] $job_def($job) log
- unset job_def($job)
- }
-
- # check for user break
- if { "[info commands dbreak]" == "dbreak" && [catch dbreak] } {
- set userbreak 1
- }
-
- # update summary log with requested period
- if { $logdir != "" && $refresh > 0 && [clock seconds] > $refresh_timer + $refresh } {
- _log_summarize $logdir $log
- set refresh_timer [clock seconds]
- }
- }
+ _testgrid_process_jobs $worker
# release thread pool
- tpool::cancel $worker [array names job_def]
+ if { $nbpooled > 0 } {
+ tpool::cancel $worker [array names job_def]
+ }
+ catch {tpool::resume $worker}
tpool::release $worker
}
set time [lindex [split [uplevel dchrono _timer show] "\n"] 0]
if { $userbreak } {
- puts "*********** Stopped by user break ***********"
+ _log_and_puts log "*********** Stopped by user break ***********"
set time "${time} \nNote: the process is not finished, stopped by user break!"
}
}
# get summary statements from all test cases in one log
- set log ""
+ set log {}
# to avoid huge listing of logs, first find all subdirectories and iterate
# by them, parsing log files in each subdirectory independently
if { "[file join $grid $caselog]" != "[file join $grp $grd ${cas}.log]" } {
puts "Error: $file contains status line for another test case ($line)"
}
- set log "$log$line\n"
+ lappend log $line
incr nbfound
}
}
# save result to log file
if { "$logfile" != "" } {
- _log_save $logfile $log
+ _log_save $logfile [join $log "\n"]
_log_html_diff "[file rootname $logfile].html" $log $dir1 $dir2
puts "Log is saved to $logfile (and .html)"
}
global env
if { $_summary != "" } { upvar $_summary summary }
if { $_html_log != "" } { upvar $_html_log html_log }
- set summary ""
- set html_log ""
+ set summary {}
+ set html_log {}
if [catch {
if [regexp -nocase {^[ \t]*TODO ([^:]*):(.*)$} $line res platforms pattern] {
if { ! [regexp -nocase {\mAll\M} $platforms] &&
! [regexp -nocase "\\m$env(os_type)\\M" $platforms] } {
- set html_log "$html_log\n$line"
+ lappend html_log $line
continue ;# TODO statement is for another platform
}
}
lappend todos [regsub -all {\\b} [string trim $pattern] {\\y}] ;# convert regexp from Perl to Tcl style
- set html_log "$html_log\n[_html_highlight BAD $line]"
+ lappend html_log [_html_highlight BAD $line]
continue
}
if { [regexp [lindex $todos $i] $line] } {
set is_known 1
incr todo_count($i)
- set html_log "$html_log\n[_html_highlight BAD $line]"
+ lappend html_log [_html_highlight BAD $line]
break
}
}
# if it is not in todo, define status
if { ! $is_known } {
set stat [lindex $bw 0 0]
- set html_log "$html_log\n[_html_highlight $stat $line]"
+ lappend html_log [_html_highlight $stat $line]
if { $status == "" && $stat != "OK" && ! [regexp -nocase {^IGNOR} $stat] } {
set status [lindex $bw 0]
}
}
}
if { ! $ismarked } {
- set html_log "$html_log\n$line"
+ lappend html_log $line
}
}
# put final message
_log_and_puts summary "CASE $group $gridname $casename: $status"
- set html_log "[_html_highlight [lindex $status 0] $summary]\n$html_log"
+ set summary [join $summary "\n"]
+ set html_log "[_html_highlight [lindex $status 0] $summary]\n[join $html_log \n]"
}
# Auxiliary procedure putting message to both cout and log variable (list)
proc _log_and_puts {logvar message} {
if { $logvar != "" } {
upvar $logvar log
- if [info exists log] {
- set log "$log$message\n"
- } else {
- set log "$message\n"
- }
+ lappend log $message
}
puts $message
}
# check result and make HTML log
_check_log $dir $group $grid $casename $output summary html_log
- set log "$log$summary"
+ lappend log $summary
# save log to file
if { $logdir != "" } {
proc _log_html_summary {logdir log totals regressions improvements total_time} {
global _test_case_regexp
- # create missing directories as needed
- catch {file mkdir $logdir}
+ # create missing directories as needed
+ file mkdir $logdir
# try to open a file and start HTML
if [catch {set fd [open $logdir/summary.html w]} res] {
puts $fd "</table>"
}
- # put detailed log
- puts $fd "<h1>Details</h1>"
+ # put detailed log with TOC
+ puts $fd "<hr><h1>Details</h1>"
+ puts $fd "<div style=\"float:right; padding: 10px; border-style: solid; border-color: blue; border-width: 2px;\">"
# process log line-by-line
set group {}
set letter {}
- foreach line [lsort -dictionary [split $log "\n"]] {
+ set body {}
+ foreach line [lsort -dictionary $log] {
# check that the line is case report in the form "CASE group grid name: result (explanation)"
if { ! [regexp $_test_case_regexp $line res grp grd casename result message] } {
continue
# start new group
if { $grp != $group } {
- if { $letter != "" } { puts $fd "</tr></table>" }
+ if { $letter != "" } { lappend body "</tr></table>" }
set letter {}
set group $grp
set grid {}
- puts $fd "<h2>Group $group</h2>"
+ puts $fd "<a href=\"#$group\">$group</a><br>"
+ lappend body "<h2><a name=\"$group\">Group $group</a></h2>"
}
# start new grid
if { $grd != $grid } {
- if { $letter != "" } { puts $fd "</tr></table>" }
+ if { $letter != "" } { lappend body "</tr></table>" }
set letter {}
set grid $grd
- puts $fd "<h3>Grid $grid</h3>"
+ puts $fd " <a href=\"#$group-$grid\">$grid</a><br>"
+ lappend body "<h2><a name=\"$group-$grid\">Grid $group $grid</a></h2>"
}
# check if test case name is <letter><digit>;
# if not, set alnum to period "." to recognize non-standard test name
- if { ! [regexp {([A-Za-z]+)([0-9]+)} $casename res alnum number] } {
- set alnum .
+ if { ! [regexp {\A([A-Za-z]{1,2})([0-9]{1,2})\Z} $casename res alnum number] &&
+ ! [regexp {\A([A-Za-z0-9]+)_([0-9]+)\Z} $casename res alnum number] } {
+ set alnum $casename
}
# start new row when letter changes or for non-standard names
if { $alnum != $letter || $alnum == "." } {
if { $letter != "" } {
- puts $fd "</tr><tr>"
+ lappend body "</tr><tr>"
} else {
+
lappend body "<table><tr>"
}
set letter $alnum
}
-
puts $fd "<td bgcolor=\"[_html_color $result]\"><a href=\"$group/$grid/${casename}.html\">$casename</a></td>"
+
lappend body "<td bgcolor=\"[_html_color $result]\"><a href=\"$group/$grid/${casename}.html\">$casename</a></td>"
}
- puts $fd "</tr></table>"
+ puts $fd "</div>\n[join $body "\n"]</tr></table>"
# add remaining lines of log as plain text
puts $fd "<h2>Plain text messages</h2>\n<pre>"
- foreach line [split $log "\n"] {
+ foreach line $log {
if { ! [regexp $_test_case_regexp $line] } {
puts $fd "$line"
}
# sort log records alphabetically to have the same behavior on Linux and Windows
# (also needed if tests are run in parallel)
- set loglist [lsort -dictionary [split $log "\n"]]
+ set loglist [lsort -dictionary $log]
# classify test cases by status
foreach line $loglist {
# save log to files
if { $logdir != "" } {
_log_html_summary $logdir $log $totals $regressions $improvements $total_time
- _log_save $logdir/tests.log $log "Tests summary"
+ _log_save $logdir/tests.log [join $log "\n"] "Tests summary"
}
return
# sort log and process it line-by-line
set group {}
- foreach line [lsort -dictionary [split $log "\n"]] {
+ foreach line [lsort -dictionary $log] {
# check that the line is case report in the form "CASE group grid name: result (explanation)"
if { ! [regexp $_test_case_regexp $line res grp grd casename result message] } {
continue
# "Executing <filename>..."
puts $fd "<pre>"
set logpath [file split [file normalize $file]]
- foreach line [split $log "\n"] {
+ foreach line $log {
puts $fd $line
if { [regexp {IMAGE[ \t]+([^:]+):[ \t]+([A-Za-z0-9_.-]+)} $line res case img] } {
file mkdir $fallback
return $fallback
}
+
+# extract of code from testgrid command used to process jobs running in
+# parallel until number of jobs in the queue becomes equal or less than
+# specified value
+proc _testgrid_process_jobs {worker {nb_ok 0}} {
+ # bind local vars to variables of the caller procedure
+ upvar log log
+ upvar logdir logdir
+ upvar job_def job_def
+ upvar nbpooled nbpooled
+ upvar userbreak userbreak
+ upvar refresh refresh
+ upvar refresh_timer refresh_timer
+
+ catch {tpool::resume $worker}
+ while { ! $userbreak && $nbpooled > $nb_ok } {
+ foreach job [tpool::wait $worker [array names job_def]] {
+ eval _log_test_case \[tpool::get $worker $job\] $job_def($job) log
+ unset job_def($job)
+ incr nbpooled -1
+ }
+
+ # check for user break
+ if { "[info commands dbreak]" == "dbreak" && [catch dbreak] } {
+ set userbreak 1
+ }
+
+ # update summary log with requested period
+ if { $logdir != "" && $refresh > 0 && [clock seconds] > $refresh_timer + $refresh } {
+ _log_summarize $logdir $log
+ set refresh_timer [clock seconds]
+ }
+ }
+ catch {tpool::suspend $worker}
+}
projects / occt.git / blobdiff