'\"
'\" Copyright (c) 1998-2000 by Scriptics Corporation.
'\" All rights reserved.
'\" 
'\" RCS: @(#) $Id: queue.n,v 1.1 2000/02/05 03:20:20 ericm Exp $
'\" 
.so man.macros
.TH queue n 8.3 Tcl "Tcl Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
::struct::queue \- Create and manipulate queue objects
.SH SYNOPSIS
\fBpackage require struct ?1.0?\fR
.sp
\fB::struct::queue\fR \fIqueueName\fR
.sp
.BE
.SH DESCRIPTION
.PP
The \fB::struct::queue\fR command creates a new queue object with an
associated global Tcl command whose name is \fIqueueName\fR.  This command
may be used to invoke various operations on the queue.  It has the
following general form:
.CS
\fIqueueName option \fR?\fIarg arg ...\fR?
.CE
\fIOption\fR and the \fIarg\fRs
determine the exact behavior of the command.  The following
commands are possible for queue objects:
.TP
\fIqueueName \fBclear\fR
Remove all items from the queue.
.TP
\fIqueueName \fBdestroy\fR
Destroy the queue, including its storage space and associated command.
.TP
\fIqueueName \fBget\fR ?\fIcount\fR?
Return the front \fIcount\fR items of the queue and remove them
from the queue.  If \fIcount\fR is not specified, it defaults to 1.
If \fIcount\fR is 1, the result is a simple string; otherwise, it is a list.
If specified, \fIcount\fR must be greater than or equal to 1.  If
there are no items in the queue, this command will return \fIcount\fR
empty strings.
.TP
\fIqueueName \fBpeek\fR ?\fIcount\fR?
Return the front \fIcount\fR items of the queue, without removing them
from the queue.  If \fIcount\fR is not specified, it defaults to 1.
If \fIcount\fR is 1, the result is a simple string; otherwise, it is a list.
If specified, \fIcount\fR must be greater than or equal to 1.  If
there are no items in the queue, this command will return \fIcount\fR
empty strings.
.TP
\fIqueueName \fBput\fR \fIitem\fR ?\fIitem ...\fR?
Put the item or items specified into the queue.  If more than one
item is given, they will be added in the order they are listed.
.TP
\fIqueueName \fBsize\fR
Return the number of items in the queue.

.SH KEYWORDS
stack, queue

'\"
'\" Copyright (c) 1998-2000 by Scriptics Corporation.
'\" All rights reserved.
'\" 
'\" RCS: @(#) $Id: stack.n,v 1.1 2000/02/05 03:20:20 ericm Exp $
'\" 
.so man.macros
.TH stack n 8.3 Tcl "Tcl Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
::struct::stack \- Create and manipulate stack objects
.SH SYNOPSIS
\fBpackage require struct ?1.0?\fR
.sp
\fB::struct::stack\fR \fIstackName\fR
.sp
.BE
.SH DESCRIPTION
.PP
The \fB::struct::stack\fR command creates a new stack object with an
associated global Tcl command whose name is \fIstackName\fR.  This command
may be used to invoke various operations on the stack.  It has the
following general form:
.CS
\fIstackName option \fR?\fIarg arg ...\fR?
.CE
\fIOption\fR and the \fIarg\fRs
determine the exact behavior of the command.  The following
commands are possible for stack objects:
.TP
\fIstackName \fBclear\fR
Remove all items from the stack.
.TP
\fIstackName \fBdestroy\fR
Destroy the stack, including its storage space and associated command.
.TP
\fIstackName \fBpeek\fR ?\fIcount\fR?
Return the top \fIcount\fR items of the stack, without removing them
from the stack.  If \fIcount\fR is not specified, it defaults to 1.
If \fIcount\fR is 1, the result is a simple string; otherwise, it is a list.
If specified, \fIcount\fR must be greater than or equal to 1.  If
there are no items on the stack, this command will return \fIcount\fR
empty strings.
.TP
\fIstackName \fBpop\fR ?\fIcount\fR?
Return the top \fIcount\fR items of the stack and remove them
from the stack.  If \fIcount\fR is not specified, it defaults to 1.
If \fIcount\fR is 1, the result is a simple string; otherwise, it is a list.
If specified, \fIcount\fR must be greater than or equal to 1.  If
there are no items on the stack, this command will return \fIcount\fR
empty strings.
.TP
\fIstackName \fBpush\fR \fIitem\fR ?\fIitem ...\fR?
Push the item or items specified onto the stack.  If more than one
item is given, they will be pushed in the order they are listed.
.TP
\fIstackName \fBsize\fR
Return the number of items on the stack.

.SH KEYWORDS
stack, queue

'\"
'\" Copyright (c) 1998-2000 by Scriptics Corporation.
'\" All rights reserved.
'\" 
'\" RCS: @(#) $Id: tree.n,v 1.1 2000/02/05 03:20:20 ericm Exp $
'\" 
.so man.macros
.TH tree n 8.3 Tcl "Tcl Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
::struct::tree \- Create and manipulate tree objects
.SH SYNOPSIS
\fBpackage require struct ?1.0?\fR
.sp
\fB::struct::tree\fR \fItreeName\fR
.sp
.BE
.SH DESCRIPTION
.PP
The \fB::struct::tree\fR command creates a new tree object with an
associated global Tcl command whose name is \fItreeName\fR.  This command
may be used to invoke various operations on the tree.  It has the
following general form:
.CS
\fItreeName option \fR?\fIarg arg ...\fR?
.CE
\fIOption\fR and the \fIarg\fRs
determine the exact behavior of the command.  The following
commands are possible for tree objects:
.TP
\fItreeName \fBclear\fR
Remove all nodes from the tree.
.TP
\fItreeName \fBdestroy\fR
Destroy the tree, including its storage space and associated command.
.TP
\fItreeName \fBinsert\fR \fIindex\fR \fIparent\fR \fIchild\fR ?-value \fIvalue\fR?
Insert a node named \fIchild\fR into the tree as a child of the node
\fIparent\fR.  If \fIparent\fR is \fBroot\fR, it refers to the root of
the tree.  The new node will have the value given by \fIvalue\fR.  The
new node will be added to the \fIparent\fR node's childlist at the
index given by \fIindex\fR.
.TP
\fItreeName\fR \fBchildren\fR \fInode\fR
Return a list of the children of \fInode\fR.
.TP
\fItreeName\fR \fBparent\fR \fInode\fR
Return the parent of \fInode\fR.
.TP
\fItreeName\fR \fBnodeconfigure\fR \fInode\fR -value \fIvalue\fR
Set the associated value of a particular node.
.TP
\fItreeName\fR \fBnodecget\fR \fInode\fR -value
Return the associated value of a particular node.
.TP
\fItreeName\fR \fBdelete\fR \fInode\fR ?\fInode\fR ...?
Remove the specified nodes from the tree.  All of the nodes' children
will be removed as well to prevent orphaned nodes.  An entire tree
could be removed in this fashion with the command:
.CS
\fItreeName\fR \fBdelete\fR [\fItreeName\fR \fBchildren\fR root]
.CE
.TP
\fItreeName\fR \fBmove\fR \fInode\fR \fIparent\fR \fIindex\fR
Make \fInode\fR a child of \fIparent\fR, inserting it
into the parent's child list at the index given by \fIindex\fR.
.TP
\fItreeName\fR \fBexists\fR \fInode\fR
Remove true if the specified node exists in the tree.

.SH KEYWORDS
tree

# Tcl package index file, version 1.1
# This file is generated by the "pkg_mkIndex" command
# and sourced either when an application starts up or
# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

package ifneeded struct 1.0 [list source [file join $dir struct.tcl]]

# queue.tcl --
#
#	Queue implementation for Tcl.
#
# Copyright (c) 1998-2000 by Scriptics Corporation.
# All rights reserved.
# 
# RCS: @(#) $Id: queue.tcl,v 1.1 2000/02/05 03:20:20 ericm Exp $

namespace eval ::struct {}

namespace eval ::struct::queue {
    # The queues array holds all of the queues you've made
    variable queues
    
    # counter is used to give a unique name for unnamed queues
    variable counter 0

    # commands is the list of subcommands recognized by the queue
    variable commands [list \
	    "clear"	\
	    "destroy"	\
	    "get"	\
	    "peek"	\
	    "put"	\
	    "size"	\
	    ]

    # Only export one command, the one used to instantiate a new queue
    namespace export queue
}

# ::struct::queue::queue --
#
#	Create a new queue with a given name; if no name is given, use
#	queueX, where X is a number.
#
# Arguments:
#	name	name of the queue; if null, generate one.
#
# Results:
#	name	name of the queue created

proc ::struct::queue::queue {{name ""}} {
    variable queues
    variable counter
    
    if { [llength [info level 0]] == 1 } {
	incr counter
	set name "queue${counter}"
    }

    if { ![string equal [info commands ::$name] ""] } {
	error "command \"$name\" already exists, unable to create queue"
    }

    # Initialize the queue as empty
    set queues($name) [list ]

    # Create the command to manipulate the queue
    interp alias {} ::$name {} ::struct::queue::QueueProc $name

    return $name
}

##########################
# Private functions follow

# ::struct::queue::QueueProc --
#
#	Command that processes all queue object commands.
#
# Arguments:
#	name	name of the queue object to manipulate.
#	args	command name and args for the command
#
# Results:
#	Varies based on command to perform

proc ::struct::queue::QueueProc {name {cmd ""} args} {
    # Make sure this queue exists
    if { ![info exists ::struct::queue::queues($name)] } {
	error "unknown queue \"$name\""
    }

    # Do minimal args checks here
    if { [llength [info level 0]] == 2 } {
	error "wrong # args: should be \"$name option ?arg arg ...?\""
    }
    
    # Split the args into command and args components
    if { [string equal [info commands ::struct::queue::_$cmd] ""] } {
	variable commands
	set optlist [join $commands ", "]
	set optlist [linsert $optlist "end-1" "or"]
	error "bad option \"$cmd\": must be $optlist"
    }
    return [uplevel 1 [list ::struct::queue::_$cmd $name] $args]
}

# ::struct::queue::_clear --
#
#	Clear a queue.
#
# Arguments:
#	name	name of the queue object.
#
# Results:
#	None.

proc ::struct::queue::_clear {name} {
    variable queues
    set queues($name) [list ]
    return
}

# ::struct::queue::_destroy --
#
#	Destroy a queue object by removing it's storage space and 
#	eliminating it's proc.
#
# Arguments:
#	name	name of the queue object.
#
# Results:
#	None.

proc ::struct::queue::_destroy {name} {
    variable queues
    unset queues($name)
    interp alias {} ::$name {}
    return
}

# ::struct::queue::_get --
#
#	Get an item from a queue.
#
# Arguments:
#	name	name of the queue object.
#	count	number of items to get; defaults to 1
#
# Results:
#	item	first count items from the queue; if there are not enough 
#		items in the queue, throws an error.

proc ::struct::queue::_get {name {count 1}} {
    variable queues
    if { $count < 1 } {
	error "invalid item count $count"
    }

    if { $count > [llength $queues($name)] } {
	error "insufficient items in queue to fill request"
    }

    if { $count == 1 } {
	# Handle this as a special case, so single item gets aren't listified
	set item [lindex $queues($name) 0]
	set queues($name) [lreplace $queues($name) 0 0]
	return $item
    }

    # Otherwise, return a list of items
    set index [expr {$count - 1}]
    set result [lrange $queues($name) 0 $index]
    set queues($name) [lreplace $queues($name) 0 $index]

    return $result
}

# ::struct::queue::_peek --
#
#	Retrive the value of an item on the queue without removing it.
#
# Arguments:
#	name	name of the queue object.
#	count	number of items to peek; defaults to 1
#
# Results:
#	items	top count items from the queue; if there are not enough items
#		to fufill the request, throws an error.

proc ::struct::queue::_peek {name {count 1}} {
    variable queues
    if { $count < 1 } {
	error "invalid item count $count"
    }

    if { $count > [llength $queues($name)] } {
	error "insufficient items in queue to fill request"
    }

    if { $count == 1 } {
	# Handle this as a special case, so single item pops aren't listified
	return [lindex $queues($name) 0]
    }

    # Otherwise, return a list of items
    set index [expr {$count - 1}]
    return [lrange $queues($name) 0 $index]
}

# ::struct::queue::_put --
#
#	Put an item into a queue.
#
# Arguments:
#	name	name of the queue object
#	args	items to put.
#
# Results:
#	None.

proc ::struct::queue::_put {name args} {
    variable queues
    if { [llength $args] == 0 } {
	error "wrong # args: should be \"$name put item ?item ...?\""
    }
    foreach item $args {
	lappend queues($name) $item
    }
    return
}

# ::struct::queue::_size --
#
#	Return the number of objects on a queue.
#
# Arguments:
#	name	name of the queue object.
#
# Results:
#	count	number of items on the queue.

proc ::struct::queue::_size {name} {
    variable queues
    return [llength $queues($name)]
}

# stack.tcl --
#
#	Stack implementation for Tcl.
#
# Copyright (c) 1998-2000 by Scriptics Corporation.
# All rights reserved.
# 
# RCS: @(#) $Id: stack.tcl,v 1.1 2000/02/05 03:20:20 ericm Exp $

namespace eval ::struct {}

namespace eval ::struct::stack {
    # The stacks array holds all of the stacks you've made
    variable stacks
    
    # counter is used to give a unique name for unnamed stacks
    variable counter 0

    # commands is the list of subcommands recognized by the stack
    variable commands [list \
	    "clear"	\
	    "destroy"	\
	    "peek"	\
	    "pop"	\
	    "push"	\
	    "rotate"	\
	    "size"	\
	    ]

    # Only export one command, the one used to instantiate a new stack
    namespace export stack
}

# ::struct::stack::stack --
#
#	Create a new stack with a given name; if no name is given, use
#	stackX, where X is a number.
#
# Arguments:
#	name	name of the stack; if null, generate one.
#
# Results:
#	name	name of the stack created

proc ::struct::stack::stack {{name ""}} {
    variable stacks
    variable counter
    
    if { [llength [info level 0]] == 1 } {
	incr counter
	set name "stack${counter}"
    }

    if { ![string equal [info commands ::$name] ""] } {
	error "command \"$name\" already exists, unable to create stack"
    }
    set stacks($name) [list ]

    # Create the command to manipulate the stack
    interp alias {} ::$name {} ::struct::stack::StackProc $name

    return $name
}

##########################
# Private functions follow

# ::struct::stack::StackProc --
#
#	Command that processes all stack object commands.
#
# Arguments:
#	name	name of the stack object to manipulate.
#	args	command name and args for the command
#
# Results:
#	Varies based on command to perform

proc ::struct::stack::StackProc {name {cmd ""} args} {
    # Make sure this stack exists
    if { ![info exists ::struct::stack::stacks($name)] } {
	error "unknown stack \"$name\""
    }

    # Do minimal args checks here
    if { [llength [info level 0]] == 2 } {
	error "wrong # args: should be \"$name option ?arg arg ...?\""
    }
    
    # Split the args into command and args components
    if { [llength [info commands ::struct::stack::_$cmd]] == 0 } {
	variable commands
	set optlist [join $commands ", "]
	set optlist [linsert $optlist "end-1" "or"]
	error "bad option \"$cmd\": must be $optlist"
    }
    return [eval [list ::struct::stack::_$cmd $name] $args]
}

# ::struct::stack::_clear --
#
#	Clear a stack.
#
# Arguments:
#	name	name of the stack object.
#
# Results:
#	None.

proc ::struct::stack::_clear {name} {
    set ::struct::stack::stacks($name) [list ]
    return
}

# ::struct::stack::_destroy --
#
#	Destroy a stack object by removing it's storage space and 
#	eliminating it's proc.
#
# Arguments:
#	name	name of the stack object.
#
# Results:
#	None.

proc ::struct::stack::_destroy {name} {
    unset ::struct::stack::stacks($name)
    interp alias {} ::$name {}
    return
}

# ::struct::stack::_peek --
#
#	Retrive the value of an item on the stack without popping it.
#
# Arguments:
#	name	name of the stack object.
#	count	number of items to pop; defaults to 1
#
# Results:
#	items	top count items from the stack; if there are not enough items
#		to fufill the request, throws an error.

proc ::struct::stack::_peek {name {count 1}} {
    variable stacks
    if { $count < 1 } {
	error "invalid item count $count"
    }

    if { $count > [llength $stacks($name)] } {
	error "insufficient items on stack to fill request"
    }

    if { $count == 1 } {
	# Handle this as a special case, so single item pops aren't listified
	set item [lindex $stacks($name) end]
	return $item
    }

    # Otherwise, return a list of items
    set result [list ]
    for {set i 0} {$i < $count} {incr i} {
	lappend result [lindex $stacks($name) "end-${i}"]
    }
    return $result
}

# ::struct::stack::_pop --
#
#	Pop an item off a stack.
#
# Arguments:
#	name	name of the stack object.
#	count	number of items to pop; defaults to 1
#
# Results:
#	item	top count items from the stack; if the stack is empty, 
#		returns a list of count nulls.

proc ::struct::stack::_pop {name {count 1}} {
    variable stacks
    if { $count > [llength $stacks($name)] } {
	error "insufficient items on stack to fill request"
    } elseif { $count < 1 } {
	error "invalid item count $count"
    }

    if { $count == 1 } {
	# Handle this as a special case, so single item pops aren't listified
	set item [lindex $stacks($name) end]
	set stacks($name) [lreplace $stacks($name) end end]
	return $item
    }

    # Otherwise, return a list of items
    set result [list ]
    for {set i 0} {$i < $count} {incr i} {
	lappend result [lindex $stacks($name) "end-${i}"]
    }

    # Remove these items from the stack
    incr i -1
    set stacks($name) [lreplace $stacks($name) "end-${i}" end]

    return $result
}

# ::struct::stack::_push --
#
#	Push an item onto a stack.
#
# Arguments:
#	name	name of the stack object
#	args	items to push.
#
# Results:
#	None.

proc ::struct::stack::_push {name args} {
    if { [llength $args] == 0 } {
	error "wrong # args: should be \"$name push item ?item ...?\""
    }
    foreach item $args {
	lappend ::struct::stack::stacks($name) $item
    }
    return
}

# ::struct::stack::_rotate --
#
#	Rotate the top count number of items by step number of steps.
#
# Arguments:
#	name	name of the stack object.
#	count	number of items to rotate.
#	steps	number of steps to rotate.
#
# Results:
#	None.

proc ::struct::stack::_rotate {name count steps} {
    variable stacks
    set len [llength $stacks($name)]
    if { $count > $len } {
	error "insufficient items on stack to fill request"
    }

    # Rotation algorithm:
    # do
    #   Find the insertion point in the stack
    #   Move the end item to the insertion point
    # repeat $steps times

    set start [expr {$len - $count}]
    set steps [expr {$steps % $count}]
    for {set i 0} {$i < $steps} {incr i} {
	set item [lindex $stacks($name) end]
	set stacks($name) [lreplace $stacks($name) end end]
	set stacks($name) [linsert $stacks($name) $start $item]
    }
    return
}

# ::struct::stack::_size --
#
#	Return the number of objects on a stack.
#
# Arguments:
#	name	name of the stack object.
#
# Results:
#	count	number of items on the stack.

proc ::struct::stack::_size {name} {
    return [llength $::struct::stack::stacks($name)]
}

package provide struct 1.0
source [file join [file dirname [info script]] stack.tcl]
source [file join [file dirname [info script]] queue.tcl]
namespace eval struct {
	namespace export *
	namespace import stack::*
	namespace import queue::*
}

# queue.test:  tests for the queue package.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1998-2000 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @(#) $Id: queue.test,v 1.1 2000/02/05 03:20:21 ericm Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import ::tcltest::*
}

package require struct
namespace import struct::*

test queue-0.1 {queue errors} {
    queue myqueue
    catch {queue myqueue} msg
    myqueue destroy
    set msg
} "command \"myqueue\" already exists, unable to create queue"
test queue-0.2 {queue errors} {
    queue myqueue
    catch {myqueue} msg
    myqueue destroy
    set msg
} "wrong # args: should be \"myqueue option ?arg arg ...?\""
test queue-0.3 {queue errors} {
    queue myqueue
    catch {myqueue foo} msg
    myqueue destroy
    set msg
} "bad option \"foo\": must be clear, destroy, get, peek, put, or size"
test queue-0.4 {queue errors} {
    catch {::struct::queue::QueueProc myqueue} msg
    set msg
} "unknown queue \"myqueue\""
test queue-0.5 {queue errors} {
    catch {queue set} msg
    set msg
} "command \"set\" already exists, unable to create queue"

test queue-1.1 {queue creation} {
    set foo [queue myqueue]
    set cmd [info commands ::myqueue]
    set size [myqueue size]
    myqueue destroy
    list $foo $cmd $size
} {myqueue ::myqueue 0}
test queue-1.2 {queue creation} {
    set foo [queue]
    set cmd [info commands ::$foo]
    set size [$foo size]
    $foo destroy
    list $foo $cmd $size
} {queue1 ::queue1 0}

test queue-2.1 {queue destroy} {
    queue myqueue
    myqueue destroy
    info commands ::myqueue
} {}
test queue-2.2 {queue destroy} {
    queue myqueue
    myqueue destroy
    catch {::struct::queue::QueueProc myqueue} msg
    set msg
} "unknown queue \"myqueue\""

test queue-3.2 {size operation} {
    queue myqueue
    myqueue put a b c d e f g
    set size [myqueue size]
    myqueue destroy
    set size
} 7
test queue-3.3 {size operation} {
    queue myqueue
    myqueue put a b c d e f g
    myqueue get 3
    set size [myqueue size]
    myqueue destroy
    set size
} 4
test queue-3.4 {size operation} {
    queue myqueue
    myqueue put a b c d e f g
    myqueue get 3
    myqueue peek 3
    set size [myqueue size]
    myqueue destroy
    set size
} 4
    
test queue-4.1 {put operation} {
    queue myqueue
    catch {myqueue put} msg
    myqueue destroy
    set msg
} "wrong # args: should be \"myqueue put item ?item ...?\""
test queue-4.2 {put operation, singleton items} {
    queue myqueue
    myqueue put a
    myqueue put b
    myqueue put c
    set result [list [myqueue get] [myqueue get] [myqueue get]]
    myqueue destroy
    set result
} "a b c"
test queue-4.3 {put operation, multiple items} {
    queue myqueue
    myqueue put a b c
    set result [list [myqueue get] [myqueue get] [myqueue get]]
    myqueue destroy
    set result
} "a b c"
test queue-4.4 {put operation, spaces in items} {
    queue myqueue
    myqueue put a b "foo bar"
    set result [list [myqueue get] [myqueue get] [myqueue get]]
    myqueue destroy
    set result
} [list a b "foo bar"]
test queue-4.5 {put operation, bad chars in items} {
    queue myqueue
    myqueue put a b \{
    set result [list [myqueue get] [myqueue get] [myqueue get]]
    myqueue destroy
    set result
} [list a b \{]

test queue-5.1 {get operation} {
    queue myqueue
    myqueue put a
    myqueue put b
    myqueue put c
    set result [list [myqueue get] [myqueue get] [myqueue get]]
    myqueue destroy
    set result
} [list a b c]
test queue-5.2 {get operation, multiple items} {
    queue myqueue
    myqueue put a
    myqueue put b
    myqueue put c
    set result [myqueue get 3]
    myqueue destroy
    set result
} [list a b c]

test queue-6.1 {peek operation} {
    queue myqueue
    myqueue put a
    myqueue put b
    myqueue put c
    set result [list [myqueue peek] [myqueue peek] [myqueue peek]]
    myqueue destroy
    set result
} [list a a a]
test queue-6.2 {get operation, multiple items} {
    queue myqueue
    myqueue put a
    myqueue put b
    myqueue put c
    set result [list [myqueue peek 3] [myqueue get 3]]
    myqueue destroy
    set result
} [list [list a b c] [list a b c]]

test queue-7.1 {clear operation} {
    queue myqueue
    myqueue put a
    myqueue put b
    myqueue put c
    set result [list [myqueue peek 3]]
    myqueue clear
    lappend result [myqueue size]
    myqueue destroy
    set result
} [list [list a b c] 0]

::tcltest::cleanupTests

# stack.test:  tests for the stack package.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1998-2000 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @(#) $Id: stackstruct.test,v 1.1 2000/02/05 03:20:21 ericm Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import ::tcltest::*
}

package require struct
namespace import struct::*

test stack-0.1 {stack errors} {
    stack mystack
    catch {stack mystack} msg
    mystack destroy
    set msg
} "command \"mystack\" already exists, unable to create stack"
test stack-0.2 {stack errors} {
    stack mystack
    catch {mystack} msg
    mystack destroy
    set msg
} "wrong # args: should be \"mystack option ?arg arg ...?\""
test stack-0.3 {stack errors} {
    stack mystack
    catch {mystack foo} msg
    mystack destroy
    set msg
} "bad option \"foo\": must be clear, destroy, peek, pop, push, rotate, or size"
test stack-0.4 {stack errors} {
    catch {::struct::stack::StackProc mystack} msg
    set msg
} "unknown stack \"mystack\""
test stack-0.5 {stack errors} {
    catch {stack set} msg
    set msg
} "command \"set\" already exists, unable to create stack"

test stack-1.1 {stack creation} {
    set foo [stack mystack]
    set cmd [info commands ::mystack]
    set size [mystack size]
    mystack destroy
    list $foo $cmd $size
} {mystack ::mystack 0}
test stack-1.2 {stack creation} {
    set foo [stack]
    set cmd [info commands ::$foo]
    set size [$foo size]
    $foo destroy
    list $foo $cmd $size
} {stack1 ::stack1 0}

test stack-2.1 {stack destroy} {
    stack mystack
    mystack destroy
    info commands ::mystack
} {}
test stack-2.2 {stack destroy} {
    stack mystack
    mystack destroy
    catch {::struct::stack::StackProc mystack} msg
    set msg
} "unknown stack \"mystack\""

test stack-3.2 {size operation} {
    stack mystack
    mystack push a b c d e f g
    set size [mystack size]
    mystack destroy
    set size
} 7
test stack-3.3 {size operation} {
    stack mystack
    mystack push a b c d e f g
    mystack pop 3
    set size [mystack size]
    mystack destroy
    set size
} 4
test stack-3.4 {size operation} {
    stack mystack
    mystack push a b c d e f g
    mystack pop 3
    mystack peek 3
    set size [mystack size]
    mystack destroy
    set size
} 4
    
test stack-4.1 {push operation} {
    stack mystack
    catch {mystack push} msg
    mystack destroy
    set msg
} "wrong # args: should be \"mystack push item ?item ...?\""
test stack-4.2 {push operation, singleton items} {
    stack mystack
    mystack push a
    mystack push b
    mystack push c
    set result [list [mystack pop] [mystack pop] [mystack pop]]
    mystack destroy
    set result
} "c b a"
test stack-4.3 {push operation, multiple items} {
    stack mystack
    mystack push a b c
    set result [list [mystack pop] [mystack pop] [mystack pop]]
    mystack destroy
    set result
} "c b a"
test stack-4.4 {push operation, spaces in items} {
    stack mystack
    mystack push a b "foo bar"
    set result [list [mystack pop] [mystack pop] [mystack pop]]
    mystack destroy
    set result
} [list "foo bar" b a]
test stack-4.5 {push operation, bad chars in items} {
    stack mystack
    mystack push a b \{
    set result [list [mystack pop] [mystack pop] [mystack pop]]
    mystack destroy
    set result
} [list \{ b a]

test stack-5.1 {pop operation} {
    stack mystack
    mystack push a
    mystack push b
    mystack push c
    set result [list [mystack pop] [mystack pop] [mystack pop]]
    mystack destroy
    set result
} [list c b a]
test stack-5.2 {pop operation, multiple items} {
    stack mystack
    mystack push a
    mystack push b
    mystack push c
    set result [mystack pop 3]
    mystack destroy
    set result
} [list c b a]

test stack-6.1 {peek operation} {
    stack mystack
    mystack push a
    mystack push b
    mystack push c
    set result [list [mystack peek] [mystack peek] [mystack peek]]
    mystack destroy
    set result
} [list c c c]
test stack-6.2 {pop operation, multiple items} {
    stack mystack
    mystack push a
    mystack push b
    mystack push c
    set result [list [mystack peek 3] [mystack pop 3]]
    mystack destroy
    set result
} [list [list c b a] [list c b a]]

test stack-7.1 {clear operation} {
    stack mystack
    mystack push a
    mystack push b
    mystack push c
    set result [list [mystack peek 3]]
    mystack clear
    lappend result [mystack size]
    mystack destroy
    set result
} [list [list c b a] 0]

test stack-8.1 {rotate operation} {
    stack mystack
    mystack push a b c d e f g h
    mystack rotate 3 1
    set result [mystack peek [mystack size]]
    mystack destroy
    set result
} [list g f h e d c b a]
test stack-8.2 {rotate operation} {
    stack mystack
    mystack push a b c d e f g h
    mystack rotate 3 2
    set result [mystack peek [mystack size]]
    mystack destroy
    set result
} [list f h g e d c b a]
test stack-8.3 {rotate operation} {
    stack mystack
    mystack push a b c d e f g h
    mystack rotate 3 5
    set result [mystack peek [mystack size]]
    mystack destroy
    set result
} [list f h g e d c b a]
test stack-8.4 {rotate operation} {
    stack mystack
    mystack push a b c d e f g h
    mystack rotate 8 1
    set result [mystack peek [mystack size]]
    mystack destroy
    set result
} [list g f e d c b a h]
test stack-8.4 {rotate operation} {
    stack mystack
    mystack push a b c d e f g h
    mystack rotate 8 -1
    set result [mystack peek [mystack size]]
    mystack destroy
    set result
} [list a h g f e d c b]


::tcltest::cleanupTests

#
# This file is a Makefile for Tcl.  If it has the name "Makefile.in"
# then it is a template for a Makefile;  to generate the actual Makefile,
# run "./configure", which is a configuration script generated by the
# "autoconf" program (constructs like "@foo@" will get replaced in the
# actual Makefile.
#
# RCS: @(#) $Id: Makefile.in,v 1.56 2000/02/05 03:20:21 ericm Exp $

VERSION 		= @TCL_VERSION@

#----------------------------------------------------------------
# Things you can change to personalize the Makefile for your own
# site (you can make these changes in either Makefile.in or
# Makefile, but changes to Makefile will get lost if you re-run

# only run by hand as yacc is not available in all environments.
# The name of the .c file is different than the name of the .y file
# so that make doesn't try to automatically regenerate the .c file.

gendate:
	yacc -l $(GENERIC_DIR)/tclGetDate.y
	sed -e 's/yy/TclDate/g' -e '/^#include <values.h>/d' \
	    -e 's?SCCSID?RCS: @(#) $$Id: Makefile.in,v 1.56 2000/02/05 03:20:21 ericm Exp $$?' \
	    -e '/#ifdef __STDC__/,/#endif/d' -e '/TclDateerrlab:/d' \
	    -e '/TclDatenewstate:/d' -e '/#pragma/d' \
	    -e '/#include <inttypes.h>/d' -e 's/const /CONST /g' \
	    <y.tab.c >$(GENERIC_DIR)/tclDate.c
	rm y.tab.c

# The following targets generate the shared libraries in dltest that

	    if [ ! -d $$i ] ; then \
		echo "Making directory $$i"; \
		mkdir -p $$i; \
		chmod 755 $$i; \
		else true; \
		fi; \
	    done;
	@for i in http2.1 http1.0 opt0.4 encoding msgcat1.0 tcltest1.0 struct1.0; \
	    do \
	    if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \
		echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
		mkdir -p $(SCRIPT_INSTALL_DIR)/$$i; \
		chmod 755 $(SCRIPT_INSTALL_DIR)/$$i; \
		else true; \
		fi; \

	    $(INSTALL_DATA) $$i $(INCLUDE_INSTALL_DIR); \
	    done;
	@echo "Installing library files to $(SCRIPT_INSTALL_DIR)";
	@for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex $(UNIX_DIR)/tclAppInit.c $(UNIX_DIR)/ldAix; \
	    do \
	    $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
	    done;
	@for i in http2.1 http1.0 opt0.4 msgcat1.0 tcltest1.0 struct1.0; \
	    do \
	    echo "Installing library $$i directory"; \
	    for j in $(TOP_DIR)/library/$$i/*.tcl ; \
		do \
		$(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/$$i; \
		done; \
	    done;

	cp -p $(GENERIC_DIR)/README $(DISTDIR)/generic
	cp -p $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic
	cp -p $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README* \
		$(TOP_DIR)/license.terms $(DISTDIR)
	mkdir $(DISTDIR)/library
	cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \
		$(TOP_DIR)/library/tclIndex $(DISTDIR)/library
	for i in http2.1 http1.0 opt0.4 msgcat1.0 reg1.0 dde1.1 tcltest1.0 struct1.0; \
	    do \
		mkdir $(DISTDIR)/library/$$i ;\
		cp -p $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \
	    done;
	mkdir $(DISTDIR)/library/encoding
	cp -p $(TOP_DIR)/library/encoding/*.enc $(DISTDIR)/library/encoding
	mkdir $(DISTDIR)/doc

#
# This file is a Makefile for Tcl.  If it has the name "Makefile.in"
# then it is a template for a Makefile;  to generate the actual Makefile,
# run "./configure", which is a configuration script generated by the
# "autoconf" program (constructs like "@foo@" will get replaced in the
# actual Makefile.
#
# RCS: @(#) $Id: Makefile.in,v 1.26 2000/02/05 03:20:22 ericm Exp $

VERSION = @TCL_VERSION@

#----------------------------------------------------------------
# Things you can change to personalize the Makefile for your own
# site (you can make these changes in either Makefile.in or
# Makefile, but changes to Makefile will get lost if you re-run

	    do \
	    if [ ! -d $$i ] ; then \
		echo "Making directory $$i"; \
		$(MKDIR) $$i; \
		else true; \
		fi; \
	    done;
	@for i in http1.0 http2.1 opt0.4 encoding msgcat1.0 tcltest1.0 struct1.0; \
	    do \
	    if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \
		echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
		$(MKDIR) $(SCRIPT_INSTALL_DIR)/$$i; \
		else true; \
		fi; \
	    done;
	@echo "Installing header files";
	@for i in "$(GENERIC_DIR)/tcl.h" "$(GENERIC_DIR)/tclDecls.h" ; \
	    do \
	    $(COPY) "$$i" "$(INCLUDE_INSTALL_DIR)"; \
	    done;
	@echo "Installing library files to $(SCRIPT_INSTALL_DIR)";
	@for i in $(ROOT_DIR)/library/*.tcl $(ROOT_DIR)/library/tclIndex; \
	    do \
	    $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \
	    done;
	@for i in http2.1 http1.0 opt0.4 msgcat1.0 tcltest1.0 struct1.0; \
	    do \
	    echo "Installing library $$i directory"; \
	    for j in $(ROOT_DIR)/library/$$i/*.tcl; \
		do \
		$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/$$i"; \
		done; \
	    done;