diff options
| -rw-r--r-- | doc/queue.n | 62 | ||||
| -rw-r--r-- | doc/stack.n | 62 | ||||
| -rw-r--r-- | doc/tree.n | 73 | ||||
| -rw-r--r-- | library/struct1.0/pkgIndex.tcl | 11 | ||||
| -rw-r--r-- | library/struct1.0/queue.tcl | 239 | ||||
| -rw-r--r-- | library/struct1.0/stack.tcl | 276 | ||||
| -rw-r--r-- | library/struct1.0/struct.tcl | 8 | ||||
| -rw-r--r-- | tests/queue.test | 186 | ||||
| -rw-r--r-- | tests/stackstruct.test | 228 | ||||
| -rw-r--r-- | unix/Makefile.in | 10 | ||||
| -rw-r--r-- | win/Makefile.in | 6 |
11 files changed, 1153 insertions, 8 deletions
diff --git a/doc/queue.n b/doc/queue.n new file mode 100644 index 0000000..7becec7 --- /dev/null +++ b/doc/queue.n @@ -0,0 +1,62 @@ +'\" +'\" 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 diff --git a/doc/stack.n b/doc/stack.n new file mode 100644 index 0000000..4c07e0b --- /dev/null +++ b/doc/stack.n @@ -0,0 +1,62 @@ +'\" +'\" 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 diff --git a/doc/tree.n b/doc/tree.n new file mode 100644 index 0000000..ff554df --- /dev/null +++ b/doc/tree.n @@ -0,0 +1,73 @@ +'\" +'\" 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 diff --git a/library/struct1.0/pkgIndex.tcl b/library/struct1.0/pkgIndex.tcl new file mode 100644 index 0000000..c1c4b4e --- /dev/null +++ b/library/struct1.0/pkgIndex.tcl @@ -0,0 +1,11 @@ +# 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]] diff --git a/library/struct1.0/queue.tcl b/library/struct1.0/queue.tcl new file mode 100644 index 0000000..22cf939 --- /dev/null +++ b/library/struct1.0/queue.tcl @@ -0,0 +1,239 @@ +# 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)] +} diff --git a/library/struct1.0/stack.tcl b/library/struct1.0/stack.tcl new file mode 100644 index 0000000..50272b7 --- /dev/null +++ b/library/struct1.0/stack.tcl @@ -0,0 +1,276 @@ +# 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)] +} diff --git a/library/struct1.0/struct.tcl b/library/struct1.0/struct.tcl new file mode 100644 index 0000000..ecacdba --- /dev/null +++ b/library/struct1.0/struct.tcl @@ -0,0 +1,8 @@ +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::* +} diff --git a/tests/queue.test b/tests/queue.test new file mode 100644 index 0000000..3ec365c --- /dev/null +++ b/tests/queue.test @@ -0,0 +1,186 @@ +# 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 diff --git a/tests/stackstruct.test b/tests/stackstruct.test new file mode 100644 index 0000000..6a5e3c5 --- /dev/null +++ b/tests/stackstruct.test @@ -0,0 +1,228 @@ +# 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 diff --git a/unix/Makefile.in b/unix/Makefile.in index 98ade77..cc34aec 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -5,7 +5,7 @@ # "autoconf" program (constructs like "@foo@" will get replaced in the # actual Makefile. # -# RCS: @(#) $Id: Makefile.in,v 1.55 2000/01/19 00:34:37 wart Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.56 2000/02/05 03:20:21 ericm Exp $ VERSION = @TCL_VERSION@ @@ -460,7 +460,7 @@ topDirName: 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.55 2000/01/19 00:34:37 wart Exp $$?' \ + -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' \ @@ -534,7 +534,7 @@ install-libraries: libraries else true; \ fi; \ done; - @for i in http2.1 http1.0 opt0.4 encoding msgcat1.0 tcltest1.0; \ + @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"; \ @@ -556,7 +556,7 @@ install-libraries: libraries do \ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \ done; - @for i in http2.1 http1.0 opt0.4 msgcat1.0 tcltest1.0; \ + @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 ; \ @@ -1077,7 +1077,7 @@ dist: $(UNIX_DIR)/configure 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; \ + 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; \ diff --git a/win/Makefile.in b/win/Makefile.in index 686c2d1..077df08 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -5,7 +5,7 @@ # "autoconf" program (constructs like "@foo@" will get replaced in the # actual Makefile. # -# RCS: @(#) $Id: Makefile.in,v 1.25 2000/02/01 11:49:39 hobbs Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.26 2000/02/05 03:20:22 ericm Exp $ VERSION = @TCL_VERSION@ @@ -438,7 +438,7 @@ install-libraries: else true; \ fi; \ done; - @for i in http1.0 http2.1 opt0.4 encoding msgcat1.0 tcltest1.0; \ + @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"; \ @@ -456,7 +456,7 @@ install-libraries: do \ $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \ done; - @for i in http2.1 http1.0 opt0.4 msgcat1.0 tcltest1.0; \ + @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; \ |