0023468: Include current branch name into default name of directory for test results

Default name for results directory is generated as "results_<branch>_<timestamp>".

In the HTML log of test execution references to script files are made HTML links to relevant files

Aded possibility to put data file for use by test script into subdirectory data of the script folder (function locate_data_file is extended to find such files).

Test demo/testsystem/A1 renamed to locate_data_file and corrected to account for the recent changes.

Default value of CSF_TestDataPath is defined pointing to $CASROOT/data

File psrse.rules corrected in accordance with changed message on missing data file

Interface of command testgrid changed:
- output directory (formerly required argument) is now defined by optional parameter -outdir
- by default tests are run in parallel mode with number of processes equal to number of system CPUs
- check for input arguments is made more strict
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.
Adjusting testing case demo draw getsource for current state of master

src/DrawResources/DrawDefault

@@ -51,6 +51,11 @@ if { [info exists env(CASROOT)] && [file isdirectory $env(CASROOT)/tests] } {
     } else {
         set env(CSF_TestScriptsPath) $env(CSF_TestScriptsPath)[_path_separator]$env(CASROOT)/tests
     }
+    if { ! [info exists env(CSF_TestDataPath)] } {
+        set env(CSF_TestDataPath) $env(CASROOT)/data
+    } else {
+        set env(CSF_TestDataPath) $env(CSF_TestDataPath)[_path_separator]$env(CASROOT)/data
+    }
 }
 
 # load application-defined initialization script, which is expected to 

src/DrawResources/TestCommands.tcl

@@ -32,16 +32,21 @@ 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 [echo=0]
   - If echo is set to 0 (default), log is stored in memory and only summary
-      is output (the log can be obtained with command \'dlog get\')
-    - If echo is set to 1, all commands and results are echoed immediately,
-      thus log is not saved and summary is not produced}
+    is output (the log can be obtained with command "dlog get")
+  - If echo is set to 1 or "-echo", all commands and results are echoed 
+    immediately, but log is not saved and summary is not produced
+}
 proc test {group grid casename {echo 0}} {
     # get test case paths (will raise error if input is invalid)
     _get_test $group $grid $casename dir gridname casefile
 
+    # if echo specified as "-echo", convert it to bool
+    if { "$echo" == "-echo" } { set echo t }
+
     # run test
     uplevel _run_test $dir $group $gridname $casefile $echo
 
@@ -54,16 +59,17 @@ proc test {group grid casename {echo 0}} {
 }
 
 # Basic command to run indicated test case in DRAW
-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)
+help testgrid {
+  Run all tests, or specified group, or one grid
+  Use: testgrid [group [grid]] [options...]
   Allowed options are:
-    -parallel N: run in parallel mode with up to N processes (default 0)
+  -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)
+  -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)
 }
-proc testgrid {logdir args} {
+proc testgrid {args} {
     global env tcl_platform _tests_verbose
 
     ######################################################
@@ -77,8 +83,9 @@ proc testgrid {logdir args} {
     }
 
     # treat options
-    set parallel 0
+    set parallel [_get_nb_cpus]
     set refresh 60
+    set logdir ""
     set overwrite 0
     set xmlfile ""
     for {set narg 0} {$narg < [llength $args]} {incr narg} {
@@ -87,10 +94,10 @@ proc testgrid {logdir args} {
 	# parallel execution
 	if { $arg == "-parallel" } {
 	    incr narg
-	    if { $narg < [llength $args] } { 
+	    if { $narg < [llength $args] && ! [regexp {^-} [lindex $args $narg]] } { 
 		set parallel [expr [lindex $args $narg]]
 	    } else {
-		set parallel 2
+		error "Option -parallel requires argument"
 	    }
 	    continue
 	}
@@ -98,10 +105,21 @@ proc testgrid {logdir args} {
 	# refresh logs time
 	if { $arg == "-refresh" } {
 	    incr narg
-	    if { $narg < [llength $args] } { 
+	    if { $narg < [llength $args] && ! [regexp {^-} [lindex $args $narg]] } { 
 		set refresh [expr [lindex $args $narg]]
 	    } else {
-		set refresh 10
+		error "Option -refresh requires argument"
+	    }
+	    continue
+	}
+
+	# output directory
+	if { $arg == "-outdir" } {
+	    incr narg
+	    if { $narg < [llength $args] && ! [regexp {^-} [lindex $args $narg]] } { 
+		set logdir [lindex $args $narg]
+	    } else {
+		error "Option -outdir requires argument"
 	    }
 	    continue
 	}
@@ -115,7 +133,7 @@ proc testgrid {logdir args} {
 	# refresh logs time
 	if { $arg == "-xml" } {
 	    incr narg
-	    if { $narg < [llength $args] } { 
+	    if { $narg < [llength $args] && ! [regexp {^-} [lindex $args $narg]] } { 
 		set xmlfile [lindex $args $narg]
 	    }
 	    if { $xmlfile == "" } {
@@ -142,8 +160,14 @@ proc testgrid {logdir args} {
     # check that target log directory is empty or does not exist
     set logdir [file normalize [string trim $logdir]]
     if { $logdir == "" } {
-	# if specified logdir is empty string, generate unique name like "results_2010-12-31T23:59:59"
-	set logdir "results_[clock format [clock seconds] -format {%Y-%m-%dT%H%M}]"
+	# if specified logdir is empty string, generate unique name like 
+        # results_<branch>_<timestamp>
+        set prefix "results"
+        if { ! [catch {exec git branch} gitout] &&
+             [regexp {[*] ([\w]+)} $gitout res branch] } {
+            set prefix "${prefix}_$branch"
+        }
+	set logdir "${prefix}_[clock format [clock seconds] -format {%Y-%m-%dT%H%M}]"
 	set logdir [file normalize $logdir]
     }
     if { [file isdirectory $logdir] && ! $overwrite && ! [catch {glob -directory $logdir *}] } {
@@ -290,7 +314,7 @@ proc testgrid {logdir args} {
 	    set worker [tpool::create -minworkers $parallel -maxworkers $parallel]
 	    # suspend the pool until all jobs are posted, to prevent blocking of the process
 	    # of starting / processing jobs by running threads
-	    tpool::suspend $worker
+	    catch {tpool::suspend $worker}
 	    if { $_tests_verbose > 0 } { _log_and_puts log "Executing tests in (up to) $parallel threads" }
 	}
     }
@@ -311,7 +335,7 @@ proc testgrid {logdir args} {
 	set fd_cmd [open $logdir/$group/$grid/${casename}.tcl w]
 	puts $fd_cmd "$imgdir_cmd"
 	puts $fd_cmd "set test_image $casename"
-	puts $fd_cmd "_run_test $dir $group $grid $casefile 1"
+	puts $fd_cmd "_run_test $dir $group $grid $casefile t"
 
 	# use dlog command to obtain complete output of the test when it is absent (i.e. since OCCT 6.6.0)
 	# note: this is not needed if echo is set to 1 in call to _run_test above
@@ -361,7 +385,7 @@ proc testgrid {logdir args} {
 
     # get results of started threads
     if { $parallel > 0 } {
-	tpool::resume $worker
+	catch {tpool::resume $worker}
 	while { [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
@@ -402,7 +426,8 @@ proc testgrid {logdir args} {
 }
 
 # Procedure to compare results of two runs of test cases
-help testdiff {Compare results of two executions of tests (CPU times, ...)
+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:
@@ -860,9 +885,29 @@ proc _log_html {file log {title {}}} {
 	puts $fd "<p><img src=\"$img\"/><p>"
     }
 
-    # print body, then end and close
+    # print log body, trying to add HTML links to script files on lines like
+    # "Executing <filename>..."
     puts $fd "<pre>"
-    puts $fd $log
+    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 "<a href=\"$url\">$script</a>"]
+        }
+        puts $fd $line
+    }
     puts $fd "</pre></body></html>"
 
     close $fd
@@ -1247,17 +1292,22 @@ proc _path_separator {} {
 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 == "" } {
-	error "Error: This procedure (locate_data_file) is for use only in test scripts!"
+    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 dir [lassign $dir name]
-			lappend dir {*}[glob -nocomplain -directory $name -type d *]
+	        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]
 		}
@@ -1265,14 +1315,15 @@ proc locate_data_file {filename} {
 	}
     }
 
-    # check datadir
+    # check current datadir
     if { [file exists [uplevel datadir]/$filename] } {
-	return [uplevel datadir]/$filename
+	return [file normalize [uplevel datadir]/$filename]
     }
 
     # raise error
-    error [join [list "Error: file $filename could not be found neither in script" \
-		      "directories nor in paths indicated by CSF_TestDataPath environment variable"] "\n"]
+    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
@@ -1389,3 +1440,38 @@ proc _test_diff {dir1 dir2 basename status verbose _logvar {_statvar ""}} {
         _log_and_puts log "Total CPU difference: $stat(cpu1) / $stat(cpu2)"
     }
 }
+
+# get number of CPUs on the system
+proc _get_nb_cpus {} {
+    global tcl_platform env
+
+    if { "$tcl_platform(platform)" == "windows" } {
+        # on Windows, take the value of the environment variable 
+        if { [info exists env(NUMBER_OF_PROCESSORS)] &&
+             ! [catch {expr $env(NUMBER_OF_PROCESSORS) > 0} res] && $res >= 0 } {
+            return $env(NUMBER_OF_PROCESSORS)
+        }
+    } elseif { "$tcl_platform(os)" == "Linux" } {
+        # on Linux, take number of logical processors listed in /proc/cpuinfo
+        if { [catch {open "/proc/cpuinfo" r} fd] } { 
+            return 0 ;# should never happen, but...
+        }
+        set nb 0
+	while { [gets $fd line] >= 0 } {
+	    if { [regexp {^processor[ \t]*:} $line] } {
+	        incr nb
+	    }
+	}
+        close $fd
+        return $nb
+    } elseif { "$tcl_platform(os)" == "Darwin" } {
+        # on MacOS X, call sysctl command
+        if { ! [catch {exec sysctl hw.ncpu} ret] && 
+             [regexp {^hw[.]ncpu[ \t]*:[ \t]*([0-9]+)} $ret res nb] } {
+            return $nb
+        }
+    }
+
+    # if cannot get good value, return 0 as default
+    return 0
+}

tests/demo/begin

@@ -1,10 +0,0 @@
-# add path to subdirectory tests_data to CSF_TestDataPath, 
-# for testing of files search procedure
-
-if { ! [info exists env(CSF_TestDataPath)] } {
-    set env(CSF_TestDataPath) "[file dirname [info script]]/tests_data"
-} elseif { ! [regexp {demo/tests_data} $env(CSF_TestDataPath)] } {
-    set env(CSF_TestDataPath) "$env(CSF_TestDataPath)[_path_separator][file dirname [info script]]/tests_data"
-}
-
-puts "CSF_TestDataPath set to $env(CSF_TestDataPath)"

tests/demo/data/file1.empty

@@ -1 +1 @@
-file used by test grid1/A1
+file used by test testsystem/locate_data_file

tests/demo/draw/getsource

@@ -1,7 +1,15 @@
 # test for command getsource
 
 # check that path returned for command pload is as expected
-set expected src/Draw/Draw_PloadCommands.cxx
+if { [array get env os_type] != "" } {
+    set os $env(os_type)
+}
+puts $os
+if { [string compare $os "windows"] == 0 } {
+    set expected src/Draw/Draw_PloadCommands.cxx
+} else {
+    set expected /src/Draw/Draw_PloadCommands.cxx
+}
 set path [lindex [getsourcefile pload] 1]
 if { [string compare $path $expected] } {
     puts "Error: command 'getsourcefile pload' returned '$path' while expected '$expected'"

tests/demo/tests_data/demo/file3.empty

@@ -1 +0,0 @@
-file used by test grid1/A1

tests/demo/tests_data/demo/testsystem/file5.empty

@@ -1 +0,0 @@
-file used by test grid1/A1

tests/demo/tests_data/file4.empty

@@ -1 +0,0 @@
-file used by test grid1/A1

tests/demo/testsystem/A1

@@ -1,17 +0,0 @@
-# Test procedure locate_data_file
-
-# Successful search
-puts "Data file 1 found in [locate_data_file file1.empty]"
-puts "Data file 2 found in [locate_data_file file2.empty]"
-puts "Data file 3 found in [locate_data_file file3.empty]"
-
-# Failed search
-if [catch {locate_data_file file4.empty}] {
-    puts "Data file file4.empty not found, that is OK"
-} else {
-    error "Data file file4.empty is found, while it should not be"
-}
-
-puts "Data file 5 found in [locate_data_file file5.empty]"
-
-puts "TEST COMPLETED"

tests/demo/testsystem/data/file2.empty

@@ -1 +1 @@
-file used by test grid1/A1
+file used by test testsystem/locate_data_file

tests/demo/testsystem/data/subdir/file6.empty

@@ -0,0 +1 @@
+file used by test testsystem/locate_data_file

tests/demo/testsystem/locate_data_file

@@ -0,0 +1,35 @@
+# Test procedure locate_data_file
+
+# add path to subdirectory tests_data to CSF_TestDataPath, 
+# for testing of files search procedure
+set addpath [file dirname [info script]]/tests_data
+if { ! [info exists env(CSF_TestDataPath)] } {
+    set env(CSF_TestDataPath) $addpath
+} elseif { ! [regexp "$addpath" $env(CSF_TestDataPath)] } {
+    set env(CSF_TestDataPath) "$env(CSF_TestDataPath)[_path_separator]$addpath"
+}
+
+puts "CSF_TestDataPath set to $env(CSF_TestDataPath)"
+
+# Failed search
+if [catch {locate_data_file file1.empty} path] {
+    puts "Data file file1.empty not found, that is OK"
+} else {
+    error "Data file file1.empty is found at $path, while it should not be"
+}
+
+# Successful search
+puts "Data file 2 found in [locate_data_file file2.empty]"
+puts "Data file 3 found in [locate_data_file file3.empty]"
+puts "Data file 4 found in [locate_data_file file4.empty]"
+puts "Data file 5 found in [locate_data_file file5.empty]"
+
+# Failed search
+if [catch {locate_data_file file6.empty} path] {
+    puts "Data file file6.empty not found, that is OK"
+} else {
+    error "Data file file6.empty is found at $path, while it should not be"
+}
+
+
+puts "TEST COMPLETED"

tests/demo/testsystem/tests_data/demo/file3.empty

@@ -0,0 +1 @@
+file used by test testsystem/locate_data_file

tests/demo/testsystem/tests_data/demo/testsystem/file5.empty

@@ -0,0 +1 @@
+file used by test testsystem/locate_data_file

tests/demo/testsystem/tests_data/file4.empty

@@ -0,0 +1 @@
+file used by test testsystem/locate_data_file

tests/mesh/end

@@ -6,7 +6,7 @@ if { [string compare ${TheFileName} ""] != 0 } {
         set is_brep [regexp "\.rle" $TheFileName]
     }
     if {$is_brep == 1} {
-        puts [brestore [locate_data_file ${TheFileName}] res]
+        puts [brestore [locate_data_file $TheFileName] res]
     } else {
         if { [array get Draw_Groups "DE: STEP"] == "" } {
 	    pload XDE

tests/parse.rules

@@ -1,6 +1,4 @@
-SKIPPED /Cannot open file for reading/ data file is missing
-SKIPPED /Could not read file .*, abandon/ data file is missing
-SKIPPED /Tcl Exception: Error: file .* could not be found neither in script/ data file is missing
+SKIPPED /Tcl Exception: Error: file .* could not be found/ data file is missing
 IGNORE /Tcl Exception: [*][*] Exception [*][*]/ duplicate report on exception on Tcl level
 FAILED /\b[Ee]xception\b/ exception
 FAILED /\bError\b/ error