bug fix in cawait if ENUM and -num

This commit is contained in:
portmann
2015-03-31 15:46:11 +00:00
parent 95d621e508
commit 686ceb70b1
+34 -25
View File
@@ -2,16 +2,17 @@
# ca* by Dirk Zimoch
# $Source: /cvs/G/EPICS/App/scripts/ca,v $
# $Date: 2015/03/30 13:06:39 $
# $Date: 2015/03/31 15:46:11 $
regsub -all {\$} {ca* by Dirk Zimoch
$Source: /cvs/G/EPICS/App/scripts/ca,v $
$Revision: 1.26 $
$Date: 2015/03/30 13:06:39 $} {} version
$Revision: 1.27 $
$Date: 2015/03/31 15:46:11 $} {} version
package require Tclx
package require Epics
# possible flags and what they are for
set possFlags(-date) " add record execution date"
set possFlags(-d) " same as -date"
set possFlags(-localdate) " add host date"
@@ -30,10 +31,7 @@ set possFlags(-timeout) " <sec> timeout cawait after <sec> seconds"
set possFlags(-num) " show enums as numeric values"
set possFlags(-n) " <num> exit after <num> updates (for camon)"
set possFlags(-version) " print version and exit"
set possFlags(-ver) " same as -version"
set possFlags(-v) " same as -version"
set possFlags(-help) " print this help text and exit"
set possFlags(-h) " same as -help"
proc printHelp {} {
global possFlags
@@ -65,6 +63,12 @@ proc check_n {i} {
set n $i
if {[catch {incr n}]} {puts stderr "-n flag expects an integer"; set n 1}
}
proc check_flag {f} {
global flags possFlags
if {[clength [array names possFlags -exact $f]] > 0} {
lappend flags $f
} else {puts stderr "not valid flag: $f"}
}
if {![regexp {gets|get|putq|put|info|mon|do|wait} [file tail $argv0] command]} {
if [regexp {gets|get|putq|put|info|mon|do|wait} [lindex $argv 0] command] {
@@ -78,24 +82,21 @@ if {![regexp {gets|get|putq|put|info|mon|do|wait} [file tail $argv0] command]} {
set flags {}
set n 0
while {[string match "-*" [set flag [lindex $argv 0]]]} {
if {[clength [array names possFlags -exact $flag]] > 0} {
switch -regexp -- $flag {
{^-(\?)|(h(elp)?)$} { printHelp; exit}
{^-(v(er(sion)?)?)$} { puts $version; exit }
{^-timeout} { set timeout [lindex $argv 1]
set argv [lrange $argv 2 end] }
{^-prec} { set prec [lindex $argv 1]
set argv [lrange $argv 2 end] }
{^-num} { lappend flags $flag
set argv [lrange $argv 1 end] }
{^-n} { check_n [lindex $argv 1];
set argv [lrange $argv 2 end] }
default { lappend flags $flag
set argv [lrange $argv 1 end] }
}
} else {set argv [lrange $argv 1 end]; append erme " $flag"}
switch -regexp -- $flag {
{^-(\?)|(h(elp)?)$} { printHelp; exit}
{^-(v(er(sion)?)?)$} { puts $version; exit }
{^-timeout} { set timeout [lindex $argv 1]
set argv [lrange $argv 2 end] }
{^-prec} { set prec [lindex $argv 1]
set argv [lrange $argv 2 end] }
{^-num} { lappend flags $flag
set argv [lrange $argv 1 end] }
{^-n} { check_n [lindex $argv 1];
set argv [lrange $argv 2 end] }
default { check_flag $flag
set argv [lrange $argv 1 end] }
}
}
if {[info exists erme]} {puts stderr "not valid flag(s): $erme"; unset erme}
if {[llength $argv] == 0} { printHelp; exit 1 }
proc bgerror {msg} {
@@ -241,7 +242,7 @@ proc parsecond {cond} {
}
proc monitor {channel condition io value stat sevr time} {
global info oldval n
global info oldval n flags
if {$io != "OK"} {
unset info($channel)
unset oldval($channel)
@@ -251,6 +252,9 @@ proc monitor {channel condition io value stat sevr time} {
if {![info exists info($channel)]} {
set info($channel) [pvinfo $channel]
}
foreach {attr val} $info($channel) {
set $attr $val
}
set newval [formatval $channel $value $stat $sevr $time]
if {$condition == {}} {
if {[info exists oldval($channel)] && $oldval($channel) == $newval} return
@@ -259,10 +263,15 @@ proc monitor {channel condition io value stat sevr time} {
if {$n > 0 && [incr n -1] < 1} { exit }
return
}
if {$TYPE == "DBF_ENUM" && [lsearch $flags -num] >= 0} {
set v [lsearch $ENUM $value]
if {$v != -1} {set value $v}
}
if [expr $condition] {
puts $newval
exit
}
}
}
set faults 0