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:sheila@feafaroth.org if you're
interested.

----

I needed to use a queue, and saw that the newer versions of
tcl had it. Yet, I need to be able to make sure people who 
are running my tool with older versions of tcl don't have 
problems, so I wrote wrappers. I don't know if it will be
helpful for anyone else, but I thought I would past it here.
I can't seem to get formatting right thought. arg.

 #------------------------------------------------------------------------------
 # 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
 }

 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)
    }
 }

 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)]
    }
 }


 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])"
 }



----
[Category Person]