#--------------------------------------------------------------------------
# This is a set of utilities for testing SICServers on instruments
#
# Mark Koennecke, November 2006, March 2007
#-------------------------------------------------------------------------
proc testInventory {inventory} {
    set txt [sicscommand list]
    set objList [split $txt ,]
    set missing 0
    foreach obj $inventory {
	if {[lsearch $objList $obj] < 0} {
	    incr missing
	    puts stdout "MISSING: $obj"
        }
    }
    return $missing
}
#-----------------------------------------------------------------------
proc SICSValue {command} {
	set txt [eval $command]
	set l [split $txt =]
	return [string trim [lindex $l 1]]
}
#-----------------------------------------------------------------------
proc max {one two} {
    if {$one > $two} {
	return $one
    } else {
	return $two
    }
}
#------------------------------------------------------------------------
# Test Motors. All are read: if they are not in the notList we will 
# try driving them by 1 %. Drivecommand can either be drive of dr, 
# depending on instrument
#-----------------------------------------------------------------------
proc testMotors {drivecommand motorList notList} {
    set failed 0
    foreach mot $motorList {
	if {[lsearch $notList $mot] < 0 } {
	    puts stdout "Testing $mot"
	    set rawVal [eval $mot]
	    if {[string first ERROR $rawVal] >= 0} {
		puts stdout "MOTOR: failed to read $mot, error $rawVal"
		incr failed
		continue
	    }
	    set val [string trim [lindex [split $rawVal =] 1]]
#----------- test drive three times tolerance
	    set prec [SICSValue "$mot precision"]
            set status [catch {set move [expr $prec * 3.]} msg]
#------- this fixes virtual motors which will not have a precision
	    if {$status != 0} {
		set move 0.3
            }
	    set newval [expr $val + $move]
	    set status [catch {eval $drivecommand $mot $newval} msg]
	    if {[string first ERROR $msg] >= 0 } {
#------------ if we went into a limit, we try the other direction	       
		if {[string first limit $msg] > 0} {
		    set newval [expr $val - $move]
		    set status [catch {eval $drivecommand $mot $newval} msg]
                }
            }
	    if {[string first ERROR $msg] >= 0} {
		puts stdout "MOTOR: failed to drive $mot with $msg"
		incr failed
                continue
	    }
#---------- drive back 
            set status [catch {eval $drivecommand $mot $val} msg]
	    if {[string first ERROR $msg] >= 0 } {
		puts stdout "MOTOR: failed to drive $mot back with $msg"
		incr failed
	    }
	}
    }
    return $failed
}
#------------------------------------------------------------------------
proc testSaveAndRestore {dir} {
    backup $dir/insttest.tcl
    recover $dir/insttest.tcl
    backup $dir/instdiff.tcl
    set f1 [exe print $dir/insttest.tcl]
    set f2 [exe print $dir/instdiff.tcl]
    set out [open b1.tcl w]
    puts $out $f1
    close $out
    set out [open b2.tcl w]
    puts $out $f2
    close $out
    set status [catch {exec diff b1.tcl b2.tcl} msg]
    if {$status != 0} { 
	puts stdout \
	"BACKUP/RESTORE: Serious problem: differences in restored parameters"
        puts stdout "BACKUP/RESTORE: look at diff between b1.tcl and b2.tcl"
    } else {
	file delete b1.tcl
	file delete b2.tcl
    }
}
#------------------------------------------------------------------------
proc testCommand args {
    set command [join $args]
    set status [catch {eval $command} txt]
    if {$status != 0} {
       puts stdout "COMMAND: Command $command returned with error $txt"
       return 0
    }
    if {[string first ERROR $txt] >= 0} {
	puts stdout "COMMAND: problem while executing command $command"
	puts stdout "COMMAND: output is $txt"
	return 0
    }
    if {[string first WARNING $txt] >= 0} {
	puts stdout "COMMAND: warning while executing command $command"
	puts stdout "COMMAND: output is: $txt"
    }
    return 1
}
#------------------------------------------------------------------------
proc testCommandList {commandList} {
    set count 0
    foreach command $commandList {
        puts stdout "Testing $command"
	if {![testCommand $command]} {
	    incr count
	}
    }
    return $count
}
#------------------------------------------------------------------------
proc testCommandInterrupt {command instrument user password} {
    catch {exec ./interrupt.tcl $instrument $user $password &} msg
    set txt1 [sicscommand $command]
    set t1 [string match -nocase "*stop*" $txt1]
    set txt2 [status] 
    set t2 [string match -nocase "*eager*" $txt2]
    if {$t1 != 1 || $t2 != 1} {
	puts stdout "INTERRUPT: Interrupting $command failed!"
	puts stdout "INTERRUPT: message is $txt1"
	puts stdout "INTERRUPT: status = $txt2"
	puts stdout "Tests after this may fail!"
        error "No interrupt"
    }
}
#------------------------------------------------------------------------
proc testInterruptList {comList instrument user password} {
    set int 0
    foreach com $comList {
	set status \
	    [catch {testCommandInterrupt $com $instrument $user $password} msg]
	if {$status != 0} {
	    incr int
	}
    }
    return $int
}
#-----------------------------------------------------------------------
proc testVarValue {command value {precision NA}} {
    set txt [eval $command]
    if {[string first ERROR $txt] >= 0} {
	error "Failed to read variable $command"
    }
    if {[string first = $txt] > 0} {
	set l [split $txt =]
        set val [string trim [lindex $l 1]]
    } else {
	set val $txt
    }
    if {[string first NA $precision] >= 0} {
	if {[string first $value $val] < 0} {
	    error "Value $value not found in response $txt"
        }
    } else {
	if {abs($value-$val) > $precision} {
	    error "Bad value $val, expected $value"
        }
    }
    return OK
}
#------------------------------------------------------------------------
proc testVarList {varList} {
    puts stdout "Testing variable values"
    set count 0
    foreach var $varList {
	if {[llength $var] > 2} {
	    set status [catch {testVarValue [lindex $var 0] \
				   [lindex $var 1] [lindex $var 2]} msg]
	} else {
	    set status [catch {testVarValue [lindex $var 0] \
				   [lindex $var 1]} msg]
        }
	if {$status != 0}  {
	    set cmd [lindex $var 0]
	    puts stdout "$msg @ $cmd"
	    incr count
	} else {
        }
    }
    return $count
}
#-------------------------------------------------------------------------
proc runStandardTests {parArray} {
    upvar $parArray parameters
    if { [info exists parameters(inventory)] } {
	puts stdout "Testing Inventory.."
	lappend counters [testInventory $parameters(inventory)]
    } else {
	lappend counters 0
    }
    
    if { [info exists parameters(driveCommand)] && \
	     [info exists parameters(motorList)] && \
	     [info exists parameters(notList)] } {
	puts stdout "Testing motors... " 
	lappend counters [testMotors $parameters(driveCommand) \
			      $parameters(motorList) $parameters(notList)]
    } else {
	lappend counters 0
    }

    if { [info exists parameters(commandList)] } {
	puts stdout "Testing a list of commands"
	lappend counters [testCommandList $parameters(commandList)]
    } else {
	lappend counters 0
    }

    if { [info exists parameters(dir)] } {
	puts stdout "Testing backup/recover.."
	catch {testSaveAndRestore $parameters(dir)} msg
    } 

    if { [info exists parameters(interruptList)] && \
	     [info exists parameters(instrument)] && \
	     [info exists parameters(user)] && \
	     [info exists parameters(password)] } {
	puts stdout "Testing interrupting commands... " 
	lappend counters [testInterruptList $parameters(interruptList) \
			      $parameters(instrument) \
			      $parameters(user) $parameters(password)]
    } else {
	lappend counters 0
    }

    if {[info exists parameters(varList)]} {
	lappend counters [testVarList $parameters(varList)]
    } else {
	lappend counters 0
    }
}
#-------------------------------------------------------------------------
proc printStandardSummary {counters} {
    puts stdout [format "%d objects missing" [lindex $counters 0]]
    puts stdout [format "%d motors failed to drive" [lindex $counters 1]]
    puts stdout [format "%d commands failed" [lindex $counters 2]]
    puts stdout [format "%d commands interrupts failed" [lindex $counters 3]]
    puts stdout [format "%d variable values bad" [lindex $counters 4]] 
}
#-----------------------------------------------------------------------
proc SICSValue {command} {
    set txt [eval $command]
    set l [split $txt =]
    return [string trim [lindex $l 1]]
}
#----------------------------------------------------------------------
proc standardPrelude {inst {count co}} {
    global __threshold __batchpath
    set __threshold [SICSValue "counter getthreshold 1"]
    set __batchpath [SICSValue "exe batchpath"]
    if {[string compare $inst local] == 0} {
	catch {sicscommand "exe batchpath /$env(HOME)/tmp"} msg
    } else {
	catch {sicscommand "exe batchpath /home/$inst/tmp"} msg
    }
    catch {sicscommand "scan mode timer"} msg
    catch {sicscommand "counter setmode timer"} msg
    catch {sicscommand "counter setthreshold 1 0"} msg
    catch {sicscommand "exe upload"} msg
    catch {sicscommand "exe append counter setthreshold 1 0"} msg 
    catch {sicscommand "exe append $count timer 120"} msg
    catch {sicscommand "exe forcesave insttestbatch.tcl"} msg
}
#----------------------------------------------------------------------
proc standardRestore {} {
    global __threshold __batchpath
    catch {sicscommand "exe batchpath $__batchpath"} msg
    catch {sicscommand "scan mode monitor"} msg
    catch {sicscommand "counter setmode monitor"} msg
    catch {sicscommand "counter setthreshold 1 $__threshold"} msg
}