0023426: Tool to compare two runs of tests on the same station
authorabv <abv@opencascade.com>
Tue, 11 Sep 2012 06:37:11 +0000 (10:37 +0400)
committerabv <abv@opencascade.com>
Fri, 14 Sep 2012 13:22:48 +0000 (17:22 +0400)
New command testdiff added to compare two logs of test run. Currently only CPU times are compared, comparison of images can be added later.

src/DrawResources/TestCommands.tcl

index 246e520..f106e90 100644 (file)
@@ -18,7 +18,7 @@
 ############################################################################
 # This file defines scripts for execution of OCCT tests.
 # It should be loaded automatically when DRAW is started, and provides
-# two top-level commands: 'test' and 'testgrid'.
+# three top-level commands: 'test', 'testgrid', and 'testdiff'.
 # See OCCT Tests User Guide for description of the test system.
 #
 # Note: procedures with names starting with underscore are for internal use 
@@ -32,7 +32,7 @@ set _tests_verbose 0
 set _test_case_regexp {^CASE\s+([\w.-]+)\s+([\w.-]+)\s+([\w.-]+)\s*:\s*([\w]+)(.*)}
 
 # Basic command to run indicated test case in DRAW
-help test       {Run specified test case
+help test {Run specified test case
     Use: test group grid casename [verbose_level]
     Verbose level is 0 by default; can be set to 1 or 2}
 proc test {group grid casename {verbose {}}} {
@@ -54,7 +54,7 @@ proc test {group grid casename {verbose {}}} {
 }
 
 # Basic command to run indicated test case in DRAW
-help testgrid    {Run all tests, or specified group, or one grid
+help testgrid {Run all tests, or specified group, or one grid
     Use: testgrid logdir [group [grid]] [options...]
     Log directory should be empty (or non-existing)
     Allowed options are:
@@ -398,6 +398,98 @@ proc testgrid {logdir args} {
     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...]
+    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)
+    -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 
+}
+proc testdiff {dir1 dir2 args} {
+    if { "$dir1" == "$dir2" } {
+       error "Input directories are the same"
+    }
+
+    ######################################################
+    # check arguments
+    ######################################################
+
+    # treat options
+    set logfile ""
+    set basename ""
+    set status "same"
+    set verbose 3
+    for {set narg 0} {$narg < [llength $args]} {incr narg} {
+       set arg [lindex $args $narg]
+
+       # log file name
+       if { $arg == "-save" } {
+           incr narg
+           if { $narg < [llength $args] } { 
+               set logfile [lindex $args $narg]
+           } else {
+               error "Error: Option -save must be followed by log file name"
+           } 
+           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] } { 
+               set status [lindex $args $narg]
+            } else { set status "" }
+           if { "$status" != "same" && "$status" != "all" && "$status" != "ok" } {
+               error "Error: Option -status must be followed by one of \"same\", \"all\", or \"ok\""
+           }
+           continue
+       }
+
+       # verbose level
+       if { $arg == "-verbose" } {
+           incr narg
+           if { $narg < [llength $args] } { 
+               set verbose [expr [lindex $args $narg]]
+           }
+           continue
+       }
+
+#      if { [regexp {^-} $arg] } {
+           error "Error: unsupported option \"$arg\""
+#      }
+    }
+
+    # run diff procedure (recursive)
+    _test_diff $dir1 $dir2 $basename $status $verbose log
+
+    # save result to log file
+    if { "$logfile" != "" } {
+        _log_save $logfile $log
+    }
+
+    return
+}
+
 # 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
@@ -1190,3 +1282,118 @@ proc locate_data_file {filename} {
     error [join [list "Error: file $filename could not be found neither in script" \
                      "directories nor in paths indicated by CSF_TestDataPath environment variable"] "\n"]
 }
+
+# Procedure to make a diff and common of two lists
+proc _list_diff {list1 list2 _in1 _in2 _common} {
+    upvar $_in1 in1
+    upvar $_in2 in2
+    upvar $_common common
+
+    set in1 {}
+    set in2 {}
+    set common {}
+    foreach item $list1 {
+       if { [lsearch -exact $list2 $item] >= 0 } {
+           lappend common $item
+        } else {
+           lappend in1 $item
+       }
+    }
+    foreach item $list2 {
+       if { [lsearch -exact $common $item] < 0 } {
+           lappend in2 $item
+       }
+    }
+    return
+}
+
+# procedure to load a file to Tcl string
+proc _read_file {filename} {
+    set fd [open $filename r]
+    set result [read -nonewline $fd]
+    close $fd
+    return $result
+}
+
+# Procedure to compare results of two runs of test cases
+proc _test_diff {dir1 dir2 basename status verbose _logvar {_statvar ""}} {
+    upvar $_logvar log
+
+    # prepare variable (array) for collecting statistics
+    if { "$_statvar" != "" } {
+        upvar $_statvar stat
+    } else {
+        set stat(cpu1) 0
+        set stat(cpu2) 0
+        set log {}
+    }
+
+    # first check subdirectories
+    set path1 [file join $dir1 $basename]
+    set path2 [file join $dir2 $basename]
+    set list1 [glob -directory $path1 -types d -tails -nocomplain *]
+    set list2 [glob -directory $path2 -types d -tails -nocomplain *]
+    if { [llength $list1] >0 || [llength $list2] > 0 } {
+        _list_diff $list1 $list2 in1 in2 common
+        if { "$verbose" > 1 } {
+            if { [llength $in1] > 0 } { _log_and_puts log "Only in $path1: $in1" }
+            if { [llength $in2] > 0 } { _log_and_puts log "Only in $path2: $in2" }
+        }
+        foreach subdir $common {
+            if { "$verbose" > 2 } {
+               _log_and_puts log "Checking [file join $basename $subdir]"
+           }
+           _test_diff $dir1 $dir2 [file join $basename $subdir] $status $verbose log stat
+        }
+    } else {
+        # check log files (only if directory has no subdirs)
+        set list1 [glob -directory $path1 -types f -tails -nocomplain *.log]
+        set list2 [glob -directory $path2 -types f -tails -nocomplain *.log]
+        _list_diff $list1 $list2 in1 in2 common
+        if { "$verbose" > 1 } {
+            if { [llength $in1] > 0 } { _log_and_puts log "Only in $path1: $in1" }
+            if { [llength $in2] > 0 } { _log_and_puts log "Only in $path2: $in2" }
+        }
+        foreach logfile $common {
+            # load two logs
+           set log1 [_read_file [file join $dir1 $basename $logfile]]
+           set log2 [_read_file [file join $dir2 $basename $logfile]]
+
+            # check execution statuses
+            set status1 UNDEFINED
+            set status2 UNDEFINED
+           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"
+
+                # if test statuses are different, further comparison makes 
+               # no sense unless explicitly requested
+               if { "$status" != "all" } {
+                    continue
+               }
+           }
+           if { "$status" == "ok" && "$status1" != "OK" } { 
+               continue
+           }
+
+            # check CPU times
+            set cpu1 UNDEFINED
+            set cpu2 UNDEFINED
+           if { [regexp {TOTAL CPU TIME:\s*([\d.]+)} $log1 res1 cpu1] &&
+                [regexp {TOTAL CPU TIME:\s*([\d.]+)} $log2 res1 cpu2] } {
+                set stat(cpu1) [expr $stat(cpu1) + $cpu1]
+                set stat(cpu2) [expr $stat(cpu2) + $cpu2]
+
+                # 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"
+                }
+           }
+       }
+    }
+
+    if { "$_statvar" == "" } {
+        _log_and_puts log "Total CPU difference: $stat(cpu1) / $stat(cpu2)"
+    }
+}