I work on a tcl-based automated testing tool at the Secure Design Center in the Schaumburg Campus of Motorola and develop the hardware encryption modules (which get tested by the tool).
Initiated the Chicago Area Tcl Users Group.
Send me email at mailto:[email protected] if you're interested.
I am trying to cut and past code, so I'll practice here first.
#------------------------------------------------------------------------------ # Namespace : ::message_queue # Author : Sheila Herndon # Creation Date : 2003/04/14 #--------------------------------- PURPOSE ------------------------------------ # # Provides a simple set of enqueueing and dequeueing wrappers for the # struct::queue for a related set of queues containing messages in # message_queue(<label>). # #--------------------------------- SYNOPSIS ----------------------------------- # CAUTIONS: # people might have old versions of tcl, so I made wrappers # #------------------------- GLOBAL DATA DESCRIPTION ---------------------------- # # message_queue(<label>) the queue that will be created if we have struct support # good_tcl a boolean to test for struct support # bad_tcl_queue a stand in for when we do not have struct support # #--------------------------------- REVISIONS ---------------------------------- # Date Name Description # ---------- ------------ ---------------------------------------------------
package provide message_queue 1.0 namespace eval message_queue {
variable good_tcl 1
variable bad_tcl_queue
# initialize our namespace. if we have the appropriate
# support from tcl, then load up the struct package which
# provides native queue support, otherwise set the variable
# to tell us we don't have it.
if {[catch {package require Tcl 8.2} err]} {
if {[regexp {version conflict} $err]} {
set good_tcl 0
}
} else {
package require struct
}}
# create the queue. # the struct library creates a new procedure # the other method creates a namespace array variable proc ::message_queue::create {label} {
variable good_tcl
variable bad_tcl_queue
if {$good_tcl} {
struct::queue message_queue($label)
} else {
set bad_tcl_queue($label) ""
}}
proc ::message_queue::exists {label} {
variable good_tcl
variable bad_tcl_queue
if {$good_tcl} {
return [string equal [info commands message_queue($label)] \
message_queue($label)]
} else {
return [info exist bad_tcl_queue($label)]
}}
# put a message into the queue # if it doesn't exist, create it proc ::message_queue::enqueue {label message} {
variable good_tcl
variable bad_tcl_queue
# if it doesn't exist, create it
if {![exists $label]} {
create $label
}
if {$good_tcl} {
message_queue($label) put $message
} else {
lappend bad_tcl_queue($label) $message
}}
# remove a message from the queue and return it. # if the queue becomes emptied due to this, destroy it. proc ::message_queue::dequeue {label} {
variable good_tcl
variable bad_tcl_queue
if {$good_tcl} {
set message [message_queue($label) get]
} else {
set message [lindex $bad_tcl_queue($label) 0]
set bad_tcl_queue($label) [lreplace $bad_tcl_queue($label) 0 0]
}
# if the queue is empty, destroy it.
if {[size $label] == 0} {
destroy $label
}
return $message}
# delete the queue. proc ::message_queue::destroy {label} {
variable good_tcl
variable bad_tcl_queue
if {$good_tcl} {
message_queue($label) destroy
} else {
unset bad_tcl_queue($label)
}}
# return the size of the queue. proc ::message_queue::size {label} {
variable good_tcl
variable bad_tcl_queue
# if it doesn't exist, return -1
if {![exists $label]} {
return -1
}
if {$good_tcl} {
return [message_queue($label) size]
} else {
return [llength $bad_tcl_queue($label)]
}}
# a few test calls for queue commands proc unit_test_message_queue {} {
package require message_queue
Log "Creating message queue for foo [message_queue::create foo]"
Log "Check existence ([message_queue::exists foo])"
Log "Checking size ([expr [message_queue::size foo] == 0])"
set i 0
foreach msg {a a b} {
puts "Adding $msg to message queue ([message_queue::enqueue foo $msg])\
Checking size ([expr [message_queue::size foo] == [incr i]])"
}
foreach msg {a a b} size {2 1 -1} {
Log "Get message ([string eq [message_queue::dequeue foo] $msg])\
Checking size ([expr [message_queue::size foo] == $size])"
}
Log "Check inexistence ([expr [message_queue::exists foo] == 0])"}