sics/test/testutil.tcl

#------------------------------------------------------------------------------
# utility routines for testing SICS
#
# copyright: see file COPYRIGHT
#
# Mark Koennecke, July 2006
#------------------------------------------------------------------------------
proc SICSValue {command} {
	set txt [eval $command]
	set l [split $txt =]
	return [string trim [lindex $l 1]]
}
#-----------------------------------------------------------------------------
proc compareValue {is should {delta .01} } {
	if {[string is double $is] == 1} {
		if {abs($should - $is) > $delta} {
			error "Bad compare is: $is, should $should"
		}
	} else {
		if {[string compare $is $should] != 0} {
			error "Bad compare is: $is, should $should"
		}
	}
	return OK
}
#-----------------------------------------------------------------------------
proc compareMultiValue {is should {delta .01} } {
    set l1 [split [string trim $is]]
    set l2 [split [string trim $should]]
    if {[llength $l1 ] != [llength $l2]} {
	error "List length mismatch in compareMultiValue"
    }
    for {set i 0} {$i < [llength $l1]} {incr i } {
	compareValue [lindex $l1 $i] [lindex $l2 $i] $delta
    }
    return OK
}
#------------------------------------------------------------------------------
proc testPar {name testval priv } {
	config rights Spy Spy
	set value [SICSValue $name]
	set res [eval $name $testval]
	if {[string first ERROR $res] < 0} {
		error "Managed to set parameter even if not allowed"
	}
	config rights $priv $priv
	set res [eval $name $testval]
	if {[string first ERROR $res] >= 0} {
		error "Setting parameter failed with $res"
	}
	set readback [SICSValue $name]
	compareValue $readback $testval
	eval $name $value
	return "OK"
}
#------------------------------------------------------------------------------
proc testMultiPar {name testval priv} {
	config rights Spy Spy
	set value [SICSValue $name]
	set res [eval $name $testval]
	if {[string first ERROR $res] < 0} {
		error "Managed to set parameter even if not allowed"
	}
	config rights $priv $priv
	set res [eval $name $testval]
	if {[string first ERROR $res] >= 0} {
		error "Setting parameter failed with $res"
	}
	set readback [SICSValue $name]
	compareMultiValue $readback $testval
	eval $name $value
	return "OK"
}
#-------------------------------------------------------------------------------
proc testROPar {name val} {
	config rights Mugger Mugger
	set value [SICSValue $name]
	compareValue $value $val
	catch {$name [expr $val + 1]} msg
	set value [SICSValue $name]
        set status [catch {compareValue $value $val} msg]
	config rights Spy Spy
        if {$status == 0} {
	    error "Was able to change read-only parameter name"
	} else {
	    return OK
	}
}
#------------------------------------------------------------------------------
proc testDrive {name value priv} {
	config rights Spy Spy
	set ans [eval drive $name $value]
	if {[string first ERROR $ans] < 0} {
		error "Protection on drivable does not work"
	}
	config rights $priv $priv
	set ans [eval drive $name $value]
	if { [string first sucessfully $ans] < 0} {
		error "Driving $name failed: $ans"
	}
	set readback [SICSValue $name]
	compareValue $readback $value
	config rights Spy Spy
	return OK	
}
#------------------------------------------------------------------------------
proc testDriveInterrupt {name value} {
    global socke
	config rights Mugger Mugger
	run $name $value
	puts $socke "INT1712 3"
	flush $socke
	set ans [eval status]
	config rights Spy Spy
	if {[string first Interrupt $ans] < 0} {
		puts stdout $ans
		error "Failed to abort driving"
	}
	if { [string first Eager $ans] < 0} {
		error "Failed to finish driving"
	} 
	return OK
}
#---------------------------------------------------------------------
proc testNBCounting {startCommand waitTime} {
        set res [$startCommand]
	if {[string first ERROR $res] >= 0} {
		error "Starting count failed with $res"
	}
        exec sleep 1
        set res [SICSValue status]
        if {[string first "Count" $res] < 0} {
	    error "Status does not say counting"
        }
        exec sleep $waitTime
        set res [SICSValue status]
        if {[string first "Eager" $res] < 0} {
	    error "Counting did not stop"
        }
	return "OK"
}
#----------------------------------------------------------------
proc testBlockCounting {startCommand waitTime} {
        set res [$startCommand]
	if {[string first ERROR $res] >= 0} {
		error "Starting count failed with $res"
	}
        exec sleep $waitTime
        set res [SICSValue status]
        if {[string first "Eager" $res] < 0} {
	    error "Counting did not stop"
        }
	return "OK"
}
#---------------------------------------------------------------
proc testInterruptedCount {startCommand} {
        global socke
        set res [$startCommand]
	if {[string first ERROR $res] >= 0} {
		error "Starting count failed with $res"
	}
	puts $socke "INT1712 3"
	flush $socke
        exec sleep 10
	set ans [eval status]
	config rights Spy Spy
	if {[string first Interrupt $ans] < 0} {
		puts stdout $ans
		error "Failed to abort counting"
	}
	if { [string first Eager $ans] < 0} {
		error "Failed to finish counting"
	} 
	return OK
}
#------------------------------------------------------------------------
proc testOK {command} {
    set test [eval $command]
    if {[string first OK $test] < 0} {
	error [format "Expected OK, got %s" $test]
    }
    return OK
}
#------------------------------------------------------------------------
proc testNoError {command} {
    set test [eval $command]
    if {[string first ERROR $test] >= 0} {
	error [format "Located Error:  %s" $test]
    }
    return OK
}
#------------------------------------------------------------------------
proc testCommand {command response} {
    set result [eval $command]
    if {[string first $response $result] < 0} {
	error "Expected $response, received $result"
    }
    return OK
}