From 22db40ebf1f64e9541678c7a9ca4011baf18452b Mon Sep 17 00:00:00 2001 From: abv Date: Fri, 9 Nov 2012 16:41:36 +0400 Subject: [PATCH] 0023372: "diffimage" using in tests commands Comparison of images is implemented in testdiff command; output in HTML form generated Add measurement of memory (working set) delta in test case execution Add memory statistics to output of testdiff command Treatment of parameter -outdir of command testgrid corrected. Function locate_data_file and code to run tests in parallel revised to be usable with Tcl 8.4. Added function testsummarize: regenerate summary log of tests from test case logs Command testdiff is protected against exception raised by diffimage if images have different formats --- src/DrawResources/TestCommands.tcl | 322 +++++++++++++++++++++-------- 1 file changed, 235 insertions(+), 87 deletions(-) diff --git a/src/DrawResources/TestCommands.tcl b/src/DrawResources/TestCommands.tcl index b4a37f6ff0..41ed8e3b1c 100644 --- a/src/DrawResources/TestCommands.tcl +++ b/src/DrawResources/TestCommands.tcl @@ -425,22 +425,68 @@ proc testgrid {args} { return } +# Procedure to regenerate summary log from logs of test cases +help testsummarize { + Regenerate summary log in the test directory from logs of test cases. + This can be necessary if test grids are executed separately (e.g. on + different stations) or some grids have been re-executed. + Use: testsummarize dir +} +proc testsummarize {dir} { + global _test_case_regexp + + if { ! [file isdirectory $dir] } { + error "Error: \"$dir\" is not a directory" + } + + # get summary statements from all test cases in one log + set log "" + + # to avoid huge listing of logs, first find all subdirectories and iterate + # by them, parsing log files in each subdirectory independently + foreach grid [glob -directory $dir -types d -tails */*] { + foreach caselog [glob -nocomplain -directory [file join $dir $grid] -types f -tails *.log] { + set file [file join $dir $grid $caselog] + set nbfound 0 + set fd [open $file r] + while { [gets $fd line] >= 0 } { + if { [regexp $_test_case_regexp $line res grp grd cas status message] } { + 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" + incr nbfound + } + } + close $fd + + if { $nbfound != 1 } { + puts "Error: $file contains $nbfound status lines, expected 1" + } + } + } + + _log_summarize $dir $log "Summary regenerated from logs at [clock format [clock seconds]]" + return +} + # Procedure to compare results of two runs of test cases help testdiff { Compare results of two executions of tests (CPU times, ...) - Use: testdiff dir1 dir2 [options...] + Use: testdiff dir1 dir2 [groupname [gridname]] [options...] Where dir1 and dir2 are directories containing logs of two test runs. Allowed options are: - -save filename: save resulting log in specified file - -subdir name: compare only specified subdirectory (can be nested) + -save filename: save resulting log in specified file (default name is + \$dir1/diff-\$dir2.log); HTML log is saved with same name + and extension .html -status {same|ok|all}: filter cases for comparing by their status: same - only cases with same status are compared (default) ok - only cases with OK status in both logs are compared all - results are compared regardless of status -verbose level: 1 - output only differences - 2 - output list of logs and directories present in one of dirs only - 3 - (default) output progress messages + 2 - output also list of logs and directories present in one of dirs only + 3 - (default) output also progress messages } proc testdiff {dir1 dir2 args} { if { "$dir1" == "$dir2" } { @@ -452,7 +498,7 @@ proc testdiff {dir1 dir2 args} { ###################################################### # treat options - set logfile "" + set logfile [file join $dir1 "diff-[file tail $dir2].log"] set basename "" set status "same" set verbose 3 @@ -462,7 +508,7 @@ proc testdiff {dir1 dir2 args} { # log file name if { $arg == "-save" } { incr narg - if { $narg < [llength $args] } { + if { $narg < [llength $args] && ! [regexp {^-} [lindex $args $narg]] } { set logfile [lindex $args $narg] } else { error "Error: Option -save must be followed by log file name" @@ -470,21 +516,10 @@ proc testdiff {dir1 dir2 args} { continue } - # subdirectory to compare - if { $arg == "-subdir" } { - incr narg - if { $narg < [llength $args] } { - set basename [lindex $args $narg] - } else { - error "Error: Option -subdir must be followed by subdirectory path" - } - continue - } - # status filter if { $arg == "-status" } { incr narg - if { $narg < [llength $args] } { + if { $narg < [llength $args] && ! [regexp {^-} [lindex $args $narg]] } { set status [lindex $args $narg] } else { set status "" } if { "$status" != "same" && "$status" != "all" && "$status" != "ok" } { @@ -496,15 +531,20 @@ proc testdiff {dir1 dir2 args} { # verbose level if { $arg == "-verbose" } { incr narg - if { $narg < [llength $args] } { + if { $narg < [llength $args] && ! [regexp {^-} [lindex $args $narg]] } { set verbose [expr [lindex $args $narg]] + } else { + error "Error: Option -verbose must be followed by integer verbose level" } continue } -# if { [regexp {^-} $arg] } { + if { [regexp {^-} $arg] } { error "Error: unsupported option \"$arg\"" -# } + } + + # non-option arguments form a subdirectory path + set basename [file join $basename $arg] } # run diff procedure (recursive) @@ -513,11 +553,57 @@ proc testdiff {dir1 dir2 args} { # save result to log file if { "$logfile" != "" } { _log_save $logfile $log + _log_html_diff "[file rootname $logfile].html" $log $dir1 $dir2 + puts "Log is saved to $logfile (and .html)" } return } +# Procedure to locate data file for test given its name. +# The search is performed assuming that the function is called +# from the test case script; the search order is: +# - subdirectory "data" of the test script (grid) folder +# - subdirectories in environment variable CSF_TestDataPath +# - subdirectory set by datadir command +# If file is not found, raises Tcl error. +proc locate_data_file {filename} { + global env groupname gridname casename + + # check if the file is located in the subdirectory data of the script dir + set scriptfile [info script] + if { $scriptfile != "" } { + set path [file join [file dirname $scriptfile] data $filename] + if { [file exists $path] } { + return [file normalize $path] + } + } + + # check sub-directories in paths indicated by CSF_TestDataPath + if { [info exists env(CSF_TestDataPath)] } { + foreach dir [_split_path $env(CSF_TestDataPath)] { + while {[llength $dir] != 0} { + set name [lindex $dir 0] + set dir [lrange $dir 1 end] + eval lappend dir [glob -nocomplain -directory $name -type d *] + if { [file exists $name/$filename] } { + return [file normalize $name/$filename] + } + } + } + } + + # check current datadir + if { [file exists [uplevel datadir]/$filename] } { + return [file normalize [uplevel datadir]/$filename] + } + + # raise error + error [join [list "Error: file $filename could not be found" \ + "(should be in paths indicated by CSF_TestDataPath environment variable, " \ + "or in subfolder data in the script directory)"] "\n"] +} + # Internal procedure to find test case indicated by group, grid, and test case names; # returns: # - dir: path to the base directory of the tests group @@ -602,6 +688,7 @@ proc _run_test {scriptsdir group gridname casefile echo} { # start timer uplevel dchrono _timer reset uplevel dchrono _timer start + catch {uplevel meminfo w} membase # enable commands logging; switch to old-style mode if dlog command is not present set dlog_exists 1 @@ -677,15 +764,20 @@ proc _run_test {scriptsdir group gridname casefile echo} { # stop cpulimit killer if armed by the test cpulimit - # add timing info + # add memory and timing info + set stats "" + if { ! [catch {uplevel meminfo w} memuse] } { + set stats "MEMORY DELTA: [expr ($memuse - $membase) / 1024] KiB\n" + } uplevel dchrono _timer stop set time [uplevel dchrono _timer show] if [regexp -nocase {CPU user time:[ \t]*([0-9.e-]+)} $time res cpu] { - if { $dlog_exists && ! $echo } { - dlog add "TOTAL CPU TIME: $cpu sec" - } else { - puts "TOTAL CPU TIME: $cpu sec" - } + set stats "${stats}TOTAL CPU TIME: $cpu sec\n" + } + if { $dlog_exists && ! $echo } { + dlog add $stats + } else { + puts $stats } } @@ -866,6 +958,22 @@ proc _log_save {file log {title {}}} { return } +# Auxiliary procedure to make a (relative if possible) URL to a file for +# inclusion a reference in HTML log +proc _make_url {htmldir file} { + set htmlpath [file split [file normalize $htmldir]] + set filepath [file split [file normalize $file]] + for {set i 0} {$i < [llength $htmlpath]} {incr i} { + if { "[lindex $htmlpath $i]" != "[lindex $filepath $i]" } { + if { $i == 0 } { break } + return "[string repeat "../" [expr [llength $htmlpath] - $i - 1]][eval file join [lrange $filepath $i end]]" + } + } + + # if relative path could not be made, return full file URL + return "file://[file normalize $file]" +} + # Auxiliary procedure to save log to file proc _log_html {file log {title {}}} { # create missing directories as needed @@ -877,7 +985,7 @@ proc _log_html {file log {title {}}} { } # print header - puts $fd "$title

$title

" + puts $fd "$title

$title

" # add images if present set imgbasename [file rootname [file tail $file]] @@ -888,23 +996,10 @@ proc _log_html {file log {title {}}} { # print log body, trying to add HTML links to script files on lines like # "Executing ..." puts $fd "
"
-    set logpath [file split [file normalize $file]]
     foreach line [split $log "\n"] {
         if { [regexp {Executing[ \t]+([a-zA-Z0-9._/:-]+[^.])} $line res script] &&
              [file exists $script] } {
-
-            # generate relative path to the script file 
-            set url "file://[file normalize $script]"
-            set scriptpath [file split [file normalize $script]]
-	    for {set i 0} {$i < [llength $logpath]} {incr i} {
-                if { "[lindex $logpath $i]" != "[lindex $scriptpath $i]]" } {
-                    if { $i == 0 } { break }
-                    set url "[string repeat "../" [expr [llength $logpath] - $i - 1]]/[file join [lrange $scriptpath $i end]]"
-                    break
-                }
-            }
-
-            set line [regsub $script $line "$script"]
+            set line [regsub $script $line "$script"]
         }
         puts $fd $line
     }
@@ -1284,48 +1379,6 @@ proc _path_separator {} {
     }
 }
 
-# Procedure to locate data file for test given its name.
-# The search is performed assuming that the function is called 
-# from the test case script; the search order is:
-# - subdirectories in environment variable CSF_TestDataPath  
-# If file is not found, raises Tcl error.
-proc locate_data_file {filename} {
-    global env groupname gridname casename
-
-    # check if the file is located in the subdirectory data of the script dir
-    set scriptfile [info script]
-    if { $scriptfile != "" } {
-        set path [file join [file dirname $scriptfile] data $filename]
-	if { [file exists $path] } {
-	    return [file normalize $path]
-	}
-    }
-
-    # check sub-directories in paths indicated by CSF_TestDataPath
-    if { [info exists env(CSF_TestDataPath)] } {
-	foreach dir [_split_path $env(CSF_TestDataPath)] {
-	    while {[llength $dir] != 0} { 
-	        set name [lindex $dir 0]
-		set dir [lrange $dir 1 end]
-		eval lappend dir [glob -nocomplain -directory $name -type d *]
-		if { [file exists $name/$filename] } {
-		    return [file normalize $name/$filename]
-		}
-	    }
-	}
-    }
-
-    # check current datadir
-    if { [file exists [uplevel datadir]/$filename] } {
-	return [file normalize [uplevel datadir]/$filename]
-    }
-
-    # raise error
-    error [join [list "Error: file $filename could not be found" \
-		      "(should be in paths indicated by CSF_TestDataPath environment variable, " \
-                      "or in subfolder data in the script directory)"] "\n"]
-}
-
 # Procedure to make a diff and common of two lists
 proc _list_diff {list1 list2 _in1 _in2 _common} {
     upvar $_in1 in1
@@ -1358,16 +1411,26 @@ proc _read_file {filename} {
     return $result
 }
 
+# procedure to construct name for the mage diff file
+proc _diff_img_name {dir1 dir2 casepath imgfile} {
+    return [file join $dir1 $casepath "diff-[file tail $dir2]-$imgfile"]
+}
+
 # Procedure to compare results of two runs of test cases
 proc _test_diff {dir1 dir2 basename status verbose _logvar {_statvar ""}} {
     upvar $_logvar log
 
+    # make sure to load diffimage command
+    uplevel pload VISUALIZATION
+
     # prepare variable (array) for collecting statistics
     if { "$_statvar" != "" } {
         upvar $_statvar stat
     } else {
         set stat(cpu1) 0
         set stat(cpu2) 0
+        set stat(mem1) 0
+        set stat(mem2) 0
         set log {}
     }
 
@@ -1401,6 +1464,7 @@ proc _test_diff {dir1 dir2 basename status verbose _logvar {_statvar ""}} {
             # load two logs
 	    set log1 [_read_file [file join $dir1 $basename $logfile]]
 	    set log2 [_read_file [file join $dir2 $basename $logfile]]
+            set casename [file rootname $logfile]
 
             # check execution statuses
             set status1 UNDEFINED
@@ -1408,7 +1472,7 @@ proc _test_diff {dir1 dir2 basename status verbose _logvar {_statvar ""}} {
 	    if { ! [regexp {CASE [^:]*:\s*([\w]+)} $log1 res1 status1] ||
 	         ! [regexp {CASE [^:]*:\s*([\w]+)} $log2 res2 status2] ||
 	         "$status1" != "$status2" } {
-	        _log_and_puts log "STATUS [split $basename /] [file rootname $logfile]: $status1 / $status2"
+	        _log_and_puts log "STATUS [split $basename /] $casename: $status1 / $status2"
 
                 # if test statuses are different, further comparison makes 
  		# no sense unless explicitly requested
@@ -1430,17 +1494,101 @@ proc _test_diff {dir1 dir2 basename status verbose _logvar {_statvar ""}} {
 
                 # compare CPU times with 10% precision (but not less 0.5 sec)
 	        if { [expr abs ($cpu1 - $cpu2) > 0.5 + 0.05 * abs ($cpu1 + $cpu2)] } {
-	            _log_and_puts log "CPU [split $basename /] [file rootname $logfile]: $cpu1 / $cpu2"
+	            _log_and_puts log "CPU [split $basename /] $casename: $cpu1 / $cpu2"
                 }
 	    }
+
+            # check memory delta
+            set mem1 UNDEFINED
+            set mem2 UNDEFINED
+	    if { [regexp {MEMORY DELTA:\s*([\d.]+)} $log1 res1 mem1] &&
+	         [regexp {MEMORY DELTA:\s*([\d.]+)} $log2 res1 mem2] } {
+                set stat(mem1) [expr $stat(mem1) + $mem1]
+                set stat(mem2) [expr $stat(mem2) + $mem2]
+
+                # compare memory usage with 10% precision (but not less 16 KiB)
+	        if { [expr abs ($mem1 - $mem2) > 16 + 0.05 * abs ($mem1 + $mem2)] } {
+	            _log_and_puts log "MEMORY [split $basename /] $casename: $mem1 / $mem2"
+                }
+	    }
+
+            # check images
+            set imglist1 [glob -directory $path1 -types f -tails -nocomplain $casename*.{png,gif}]
+            set imglist2 [glob -directory $path2 -types f -tails -nocomplain $casename*.{png,gif}]
+            _list_diff $imglist1 $imglist2 imgin1 imgin2 imgcommon
+            if { "$verbose" > 1 } {
+                if { [llength $imgin1] > 0 } { _log_and_puts log "Only in $path1: $imgin1" }
+                if { [llength $imgin2] > 0 } { _log_and_puts log "Only in $path2: $imgin2" }
+            }
+            foreach imgfile $imgcommon {
+#                if { $verbose > 1 } { _log_and_puts log "Checking [split basename /] $casename: $imgfile" }
+                set diffile [_diff_img_name $dir1 $dir2 $basename $imgfile]
+                if { [catch {diffimage [file join $dir1 $basename $imgfile] \
+                                       [file join $dir2 $basename $imgfile] \
+                                       0 0 0 $diffile} diff] } {
+                    _log_and_puts log "IMAGE [split $basename /] $casename: $imgfile cannot be compared"
+                    file delete -force $diffile ;# clean possible previous result of diffimage
+                } elseif { $diff != 0 } {
+                    _log_and_puts log "IMAGE [split $basename /] $casename: $imgfile differs"
+                } else {
+                    file delete -force $diffile ;# clean useless artifact of diffimage
+                }
+            }
 	}
     }
 
     if { "$_statvar" == "" } {
+        _log_and_puts log "Total MEMORY difference: $stat(mem1) / $stat(mem2)"
         _log_and_puts log "Total CPU difference: $stat(cpu1) / $stat(cpu2)"
     }
 }
 
+# Auxiliary procedure to save log of results comparison to file
+proc _log_html_diff {file log dir1 dir2} {
+    # create missing directories as needed
+    catch {file mkdir [file dirname $file]}
+
+    # try to open a file
+    if [catch {set fd [open $file w]} res] {
+	error "Error saving log file $file: $res"
+    }
+    
+    # print header
+    puts $fd "Diff $dir1 vs. $dir2"
+    puts $fd "
Comparison of test results: $dir1 vs. $dir2
"
+
+    # print log body, trying to add HTML links to script files on lines like
+    # "Executing ..."
+    puts $fd "
"
+    set logpath [file split [file normalize $file]]
+    foreach line [split $log "\n"] {
+        puts $fd $line
+
+        if { [regexp {IMAGE[ \t]+([^:]+):[ \t]+([A-Za-z0-9_.-]+)} $line res case img] } {
+            if { [catch {eval file join "" [lrange $case 0 end-1]} gridpath] } {
+               # note: special handler for the case if test grid directoried are compared directly
+               set gridpath ""
+            }
+            set img1 ""
+            set img2 ""
+
+            set difffile [_diff_img_name $dir1 $dir2 $gridpath $img]
+            if { [file exists $difffile] } {
+                set imgd ""
+            } else {
+                set imgd "N/A"
+            }
+
+            puts $fd ""
+            puts $fd "
[file tail $dir1][file tail $dir2]Different pixels
$img1$img2$imgd
"
+        }
+    }
+    puts $fd "
"
+
+    close $fd
+    return
+}
+
 # get number of CPUs on the system
 proc _get_nb_cpus {} {
     global tcl_platform env