# Regression test interface

# Copyright (c) 2003 ICEMCFD Engineering a subsidary of ANSYS
# Author: Forest Rouse

## <h2>Regression tests</h2>
## These commands are used to create and run regression tests


## If the files guibase/exec_cmds.tcl and guibase/misc.tcl have
## been sourced, then regression_init does nothing.  If they haven't
## regression_init will source them to define cmd_gzip, cmd_rm,
## cmd_mv, and get_path

proc regression_init {} {
    global env
    
    set required [list cmd_gzip cmd_rm cmd_mv get_path]
    set ok 1
    foreach p $required {
	if {[info proc $p] == ""} {
	    set ok 0
	    break
	}
    }
    if $ok return
    
    set guidir ""
    if [info exists env(GUIBASE_DIR)] { lappend guidir $env(GUIBASE_DIR) }
    if [file isdirectory guibase] { lappend guidir guibase }
    if [file isdirectory lib/guibase] { lappend guidir lib/guibase }
    if [file isdirectory ../guibase] { lappend guidir ../guibase }
    foreach ev {VISUAL3P_ROOT V3PCLIENT_DIR ICEM_ACN} {
	if [info exists env($ev)] {
	    lappend guidir $env($ev)/lib/guibase
	    lappend guidir $env($ev)/lib/visual3p/guibase
	}
    }
    
    foreach file {misc exec_cmds} {
	foreach d $guidir {
	    set next $d/${file}.tcl
	    if [file exists $next] {
		if ![catch {uplevel \#0 source \"$next\"}] { break }
	    }
	}
    }
    
    foreach p $required {
	if {[info proc $p] == ""} {
	    error "Required proc $p not found!"
	}
    }
}
if {[catch regression_init]} {
	puts "Warning missing procedure.  Regression may not work."
}
	
## Parse a configuration as free list of options.  Two possible styles
## of regression tests.  One is to compare between files.
## Users will need to specify a backend (-backend <val>) and
## input file (-ifile <val>).  The other style is to compare a result object
## to a previously written regression test.  This is the form suitable
## for testing the state of a mesh after a series of operations
## in this case a result object interface (-rfint <val>) must be specified.
## The other required parameter is the comparison regression
## file (-cfile val).  The -rfint option takes precedence over the
## -backend option in case both options are specified.  Other possible
## options:
## -dir -- Directory macro $D refers to. $D can be used in the input
## or the regression file specifications.  Can be either absolute or
## relative path.  If not specified, defaults to REGRESSION_DIR
## environment variable or, if REGRESSION_DIR doesn't exist, the
## current directory.
## -cstyle -- regression file style.  Can be script(D) or domain.
## -prec -- precision of the regression test.  Can be double (D) or float.
## -tstep -- time step of the regression test.  Currently can only be 0.
## -compress -- whether or not to compress the test.  Default is yes (1).
## -addargs -- additional arguments to pass to load_mesh in case of
## comparing one file to another.  Default is "".
## -results -- list of results to be written to regression file.  Default
## is "".
## -regdesc -- append to regression descriptor for file to file
## comparison.  Default is "".
## -regname -- name to attach to regression test for file to file
## comparision.  If name is blank (default), name is <backend>/<file>
## compareopts -- list of options to pass to comparison routine.  Most
## useful are -minedge use (minimum edge length)*dtol as distance
## tolerance; -mapmesh map result object to regression file;
## -allfuzzy fuzzy mesh and result comparison; -dtol use this
## distance tolerance.  If minedge is on, this is the percentage of
## minimum edge length to use as distance tolerance, otherwise it
## is an absolute value.  Default is 100*FLT_EPSILON; -rtol absolute
## tolerance to use to compare results.  Default is 100*FLT_EPSILON;
## -fuzzytol is percentage of wrong answers that are allowed for
## an affirmative comparison with -allfuzzy.
## -addarg -- append value to addargs list.
## -result -- append value to results list.
## -compareopt -- append value to compareopts list.
## Note -- allfuzzy and mapmesh are not yet active.  Stay tuned to
## this channel for further information (should be about 1 week).
proc regression_parse_list {array args} {
    upvar $array config
    
    set config(--addargs) ""
    set config(--results) ""
    set config(--compareopts) ""
    
    for {set i 0} {$i < [llength $args]} {incr i} {
	set opt [lindex $args $i]
	incr i
	set val [lindex $args $i]
	
	if {[string index $opt 0] == "-"} {
	    set opt [string range $opt 1 end]
	}
	
	# special handling for append argument types -- can
	# have arbitrary number of addarg, result or compareopt
	# options
	
	switch -- $opt {
	    addarg { lappend config(-addargs) $barg}
	    result { lappend config(-results) $result }
	    compareopt { lappend config(-compareopts) $compareopt }
	    default {
		set config($opt) $val
	    }
	}
    }
    
    # handle all special append argument
    
    foreach appendarg [list addargs results compareopts] {
	if ![info exists config($appendarg)] {
	    set config($appendarg) $config(--$appendarg)
	} else {
	    set config($appendarg) "$config($appendarg) $config(--$appendarg)"
	}
	unset config(--$appendarg)
    }
    
    #default value of the regression comparison style is script
    
    if ![info exists config(cstyle)] { set config(cstyle) script }
    if ![info exists config(prec)] { set config(prec) double }
    if ![info exists config(tstep)] { set config(tstep) 0 }
    if ![info exists config(compress)] { set config(compress) 1 }
    
    # create optional arguments if we must
    
    foreach ai [list regdesc regname addargs results compareopts \
		   dir factory meshimpl] {
	if {![info exists config($ai)]} {
	    set config($ai) ""
	}
    }
}

##
## Check that the configuration array is complete
##
proc regression_check_config {array} {
    
    upvar $array config
    set usebackend 0
    if ![info exists config(rfint)] {
	set usebackend 1
	foreach ai [list backend ifile] {
	    if {![info exists config($ai)]} {
		error "Must specify either result interface or \
 a backend/file"
	    }
	}
    }
    
    foreach ai [list cstyle cfile] {
	if {![info exists config($ai)]} {
	    error "Must specify -$ai as a configuration option"
	}
    }
}

## Create a regression test using argument of the form <opt> <val>
## Two different tests can be run:  One is to compare one file to
## another file.   The other style is to compare a result object
## to a previously written regression test.  This is the form suitable
## for testing the state of a mesh after a series of operations
## in this case a result object interface (-rfint <val>) must be specified.
## The other required parameter is the comparison regression
## file (-cfile val).  The -rfint option takes precedence over the
## -backend option in case both options are specified.
## See regression_parse_list for all options.
##
proc regression_create_list {args} {
    
    regression_parse_list config $args
    regression_check_config config
    
    # Now just set local variable to the config variable
    
    foreach ai [array names config] {
	if {[string index $ai 0] != "-"} {
	    set $ai $config($ai)
	}
    }
    
    if $usebackend {
	set ofile [regression_create $dir $backend $ifile $cstyle $cfile \
		       $addargs $prec $tstep $results $regdesc \
		       $regname $compareopts $compress $factory $meshimpl]
    } else {
	set ofile [regression_create_rfint $rfint $dir $cstyle $cfile \
		       $results $prec $tstep $compareopts $compress]
    }
    return $ofile
}

## Configure an interface object for a specific factory
## and mesh implementation.  If specified as the empty string,
## do not set the value.
proc regression_configure_interface {name action factory meshimpl} {
    switch $action {
	create {
	    catch {$name delete}
	    catch {rf_interface $name}
	}
	init {}
    }
    # puts "factory = $factory / mi = $meshimpl"
    if {$factory != ""} {$name factory $factory}
    if {$meshimpl != ""} {$name mesh_impl $meshimpl}
}
    
## Create input file regression test.  Can create a file of
## regression descriptors for this style of test.  See
## regression_create_list for information on all options
## Invokes regression_create_rfint and adds a new line
## to the regression descriptor file
proc regression_create {dir backend ifile cstyle cfile {addargs ""} \
			    {prec "double"} {tstep 0} {results ""} \
			    {regdesc ""} {regname ""} {compareopts ""} \
			    {compress 1} {factory ""} {meshimpl ""}} {
    
    set sifile [regression_dirsub $dir $ifile]
    regression_configure_interface rfint create $factory $meshimpl
    eval [list rfint load_mesh $backend $sifile make_node_vars 0] $addargs
    
    if {$cstyle == "" || $cstyle == "-"} { set cstyle script }
    
    set ret [regression_create_rfint rfint $dir $cstyle $cfile \
		 $prec $tstep $results $compareopts]
    
    if {$regdesc != ""} {
	set fp [open $regdesc a]
	puts $fp [list $regname $dir $backend $ifile $cstyle $cfile \
		      $addargs $prec $tstep $results $compareopts]
	close $fp
    }
    return $ret
}

## Substitute $dir for \$D in file name
proc regression_dirsub {dir file} {
    global env
    
    if {$dir == ""} {
	if [info exists env(REGRESSION_DIR)] {
	    set dir $env(REGRESSION_DIR)
	} else {
	    set dir [pwd]
	}
    }
    regsub -all \\\$D $file $dir file
    return $file
}

## Write out a regression file.
proc regression_create_rfint {rfint dir cstyle cfile \
				  {prec "double"} {tstep 0} \
				  {results ""} {compareopts ""} \
				  {compress 1}} {
    
    set scfile [regression_dirsub $dir $cfile]
    eval [list $rfint write_mesh $cstyle $scfile "" $prec $tstep] $results
    if ![file exists $scfile] {
	error "Did not create regression test file."
    }
    
    if {$compress} {
	catch [cmd_gzip $scfile] msg
	set ofile ${scfile}.gz
	if [file exists $ofile] { set scfile $ofile }
    }
    return [list $scfile [$rfint list_info]]
}

## Similar to regression_create_list. Use free style list to run
## a regression test.  See regression_test and regression_test_rfint
## for how the regression tests are run.   See regression_create_list
## and regression_parse_list for possible options that can be set.
proc regression_test_list {args} {
    
    regression_parse_list config $args
    regression_check_config config
    
    # Now just set local variable to the config variable
    
    foreach ai [array names config] {
	if {[string index $ai 0] != "-"} {
	    set $ai $config($ai)
	}
    }
    
    if $usebackend {
	set ofile [regression_test $dir $backend $ifile $cstyle $cfile \
		       $addargs $prec $tstep $results $compareopts \
		       $factory $meshimpl]
    } else {
	set ofile [regression_test_rfint $rfint $dir $cstyle $cfile \
		       $addargs $results $prec $tstep \
		       $compareopts $factory $meshimpl]
    }
    return $ofile
}

## Compare backend file to regression file.  Opens file
## and invokes regression_test_rfint

proc regression_test {dir backend ifile cstyle cfile addargs prec tstep \
			  results compareopts {factory ""} {meshimpl ""}} {
    set sifile [regression_dirsub $dir $ifile]
    regression_configure_interface rfint create $factory $meshimpl
    eval [list rfint load_mesh -computefam -prec $prec -tstep $tstep \
	      $backend $sifile make_node_vars 0] $addargs
    
    return [list [regression_test_rfint rfint $dir $cstyle $cfile \
		      $prec $tstep $results $compareopts $factory $meshimpl] \
		[rfint list_info]]
}

## Compare result object to previously written regression file

proc regression_test_rfint {rfint dir cstyle cfile prec tstep results \
				compareopts {factory ""} {meshimpl ""}} {
    
    regression_configure_interface rfcomp create $factory $meshimpl

    set command load_mesh
    set loadopts "-prec $prec -tstep $tstep"
    switch $cstyle {
	domain {
	    set cbackend "domain"
	}
	CGNS {
	    set cbackend "readcgns"
	    append loadopts " -computefam"
	}
	script { 
	    set command load_script
	    set cbackend "-scriptfile"
	}
	default {
	    error "Regression file style $cstyle illegal"
	}
    }
    
    # uncompress compressed regression file and then move the
    # compressed file back afterwards.  Delay throwing of error
    # to move back compressed file if necessary
    
    set scfile [regression_dirsub $dir $cfile]
    set packd [regression_unpack $scfile]
    set regfile [lindex $packd 5]
    # puts "packd = $packd"
    
    set stat [catch {eval rfcomp $command $loadopts $cbackend \
			 $regfile make_node_vars 0} msg]
    regression_repack $packd
    
    # rethrow error
    
    if $stat { error $msg }
    
    set opts ""
    if {$compareopts != ""} { append opts $compareopts }
    if {$results != ""} { append opts " $results" }
    set ret [eval [list $rfint compare rfcomp] $opts]
    return [list $ret [rfcomp list_info]]
}

# unpack a regression file if possible

proc regression_unpack {cfile} {
    
    # initialization
    
    set copyfile ""
    set samedir 0
    set isc -1
    set ext [file extension $cfile]
    set regfile $cfile
    
    # See if either form of file specification works.  Compressed file
    # can be <cfile> (if ext of <cfile> is gz) or <cfile>.gz
    
    if {$ext == ".gz"} {
	set tryunzip 1
    } elseif [file exists ${cfile}.gz] {
	set tryunzip 1
	set cfile ${cfile}.gz
    } else {
	set tryunzip 0
    }
    set origfile $cfile
    set bfile [file rootname [file tail $cfile]]
    
    # try to unzip the file
    
    # puts "orig, bfile, tryunzip = $origfile $bfile $tryunzip"
    if {$tryunzip} {
	set isc 0
	
	set dir [file dirname $cfile]
	set cdir [pwd]
    
	if {$dir == $cdir || $dir == "."} {
	    set samedir 1
	    set copyfile ${cfile}.temp
	    set dcomp $cfile
	    set ofile $dir/$bfile
	} else {
	    set ofile [pwd]/$bfile
	    set copyfile ${ofile}.gz
	    set dcomp $copyfile
	}
    
	# uncompress compressed regression file.  If fails, isc will
	# be 0
    
	cmd_cp $cfile $copyfile
	set isc 0
	if ![catch {cmd_gzip -d $dcomp}] {
	    if [file exists $ofile] {
		set isc 1
		set regfile $ofile
	    }
	}
    } else {
	set ofile $cfile
    }
    
    # return descriptor of action.  Isc represents if decompression
    # was tried and/or succeeded.  Samedir flags if we copied to current
    # directory or copied the compressed file out of the way.  Origfile
    # is the originating compressed file.  copyfile is the file we copied
    # regression file to and ofile is the final output file.
    # Finally, regfile is the regression file we should use
    # regfile is ofile if decompression succeeded, origfile otherwise
    
    return [list $isc $samedir $origfile $copyfile $ofile $regfile]
}

# after we are done reading the file, repack the regression test

proc regression_repack {packd} {
    set isc [lindex $packd 0]
    if {$isc == -1} return
    
    set ofile [lindex $packd 4]
    catch {cmd_rm $ofile}
    
    set samedir [lindex $packd 1]
    if $samedir {
	set origfile [lindex $packd 2]
	set copyfile [lindex $packd 3]
	cmd_mv $copyfile $origfile
    }
}

## Create an empty regression file.  If a regression directory
## specified, that will be the REGRESSION_DIR.  File specifications with
## $D in them are relative to this directory.

proc regression_file_create {file {regression_dir ""}} {
    set fp [open $file w]
    puts $fp "\# Regression Description File"
    puts $fp "REGRESSION_DIR $regression_dir"
    close $fp
}

## Run, create, or list results for file-to-file comparisons in the
## regression descriptor file regdesc.  If the opt is run (default), then
## the regression tests will be run.  If the opt is create, then the
## comparison files will be created.  If the opt is listresults, then a
## list of results will be created and reported for each file.
## Special line "REGRESSION_DIR <dir>" will set the default
## regression file directory to  <dir>

proc regression_file {regdesc {opt run} {statout 0}} {
    global env
    
    set fp [open $regdesc r]
    set status 1
    set regreport ""
    
    while 1 {
	set line [gets $fp]
	if [eof $fp] break
	
	set line [string trim $line]
	if {[string index $line 0] == "\#" || $line == ""} continue
	
	if {[lindex $line 0] == "REGRESSION_DIR"} {
	    set dir [lindex $line 1]
	    # puts "Recognized REGRESSION_DIR - dir = $dir"
	    if {$dir != ""} { set env(REGRESSION_DIR) $dir }
	    # puts "env(RE...) = $env(REGRESSION_DIR)"
	    continue
	}
	
	set name [lindex $line 0]
	set dir [lindex $line 1]	
	set backend [lindex $line 2]
	set ifile [lindex $line 3]
	set cstyle [lindex $line 4]
	set cfile [lindex $line 5]
	set addargs [lindex $line 6]
	set prec [lindex $line 7]
	set tstep [lindex $line 8]
	set results [lindex $line 9]
	set compopts [lindex $line 10]
	set factory [lindex $line 11]
	set meshimpl [lindex $line 12]
	
	set fact ""
	set msh ""
	
	if {$factory != ""} {set fact [eval $factory]}
	if {$meshimpl != ""} {set msh [eval $meshimpl]}
	
	if {$name == ""} {
	    set name "$backend/\"$ifile\""
	}
	switch $opt {
	    run {    
		if [catch {regression_test $dir $backend $ifile $cstyle \
			       $cfile $addargs $prec $tstep $results \
			       $compopts $fact $msh} msg] {
		    set message "FAILED. $msg"
		    set status 0
		} else {
		    set message "SUCCEEDED."
		}
		set statusrep "$name... $message"
	    }
	    
	    create {
 		if [catch { regression_create $dir $backend $ifile \
				$cstyle $cfile $addargs $prec $tstep \
				$results "" "" $compopts 1 $fact $msh} msg] {
		    set message "Create FAILED. $msg"
		    set status 0
		} else {
		    set message "Create SUCCEEDED."
		}
		set statusrep "$name... $message"
	    }
	    
	    listresults {
		catch {rfint delete}
		catch {rf_interface rfint}
		if [catch {eval [list rfint load_mesh $backend $ifile] \
			       $addargs} msg] {
		    set message "List FAILED. $msg"
		    set status 0
		} else {
		    set message ""
		    set ar [rfint list_info results]
		    foreach d [lindex [lindex $ar 0] 0] {
			lappend message [lindex $d 0]
		    }
		}
		set statusrep "$name: $message"
	    }
	    
	    default {
		close $fp
		error "$opt illegal option; should be run, create, \
 or listresults"
	    }
	}
	
	if $statout {puts $statusrep}
	if {$fact != ""} {$fact delete}
	if {$msh != ""} {$msh delete}
	
	lappend regreport $statusrep
    }
    close $fp
    return [list $status $regreport]
}

## Run all regression tests specified in regdesc and report
## results to the regression report file regrepfile
## Throw an error if any one regression test fails.
## statout of 1 writes the status of the regression test to stdout

proc regression_report {regdesc regrepfile {opt run} {statout 0}} {
    set ret ""
    catch {cmd_rm $regrepfile}
    set fp [open $regrepfile w]
    
    if [catch {set ret [regression_file $regdesc $opt $statout]} msg] {
	puts $fp "Regression file failure: $msg"
	exit 1
    }
    
    # write whatever information we have into the report file
    
    foreach d [lindex $ret 1] {
	puts $fp $d
    }
    close $fp
    
    set stat [lindex $ret 0]
    if {$stat != 1} {
	error "Regression tests failed"
    }
    return $stat
}

proc regression_cleanup {} {
    catch {rfint delete}
    catch {rfcomp delete}
}
