diff options
| -rw-r--r-- | ChangeLog | 24 | ||||
| -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 |
10 files changed, 22 insertions, 1147 deletions
@@ -9,11 +9,31 @@ * unix/README: fixed notes about --enable-shared and add note about --disable-shared. +2000-02-04 Eric Melski <ericm@scriptics.com> + + * doc/tree.n: + * doc/stack.n: + * doc/queue.n: docs for tree, stack, and queue. + + * win/Makefile.in: + * unix/Makefile.in: Added struct1.0 to list of libraries to install. + + * tests/stackstruct.test: stack tests + + * tests/queue.test: queue tests + + * library/struct1.0/queue.tcl: queue data structure. + + * library/struct1.0/stack.tcl: stack data structure. + + * library/struct1.0/pkgIndex.tcl: + * library/struct1.0/struct.tcl: data structure package + 2000-02-03 Eric Melski <ericm@scriptics.com> * doc/Package.n: - * doc/packagens.n: Renamed Package.n -> packagens.n because NT is - stupid and can't deal with case-sensitive names! + * doc/packagens.n: Renamed Package.n -> packagens.n because NT + can't deal with case-sensitive names! 2000-02-02 Jeff Hobbs <hobbs@scriptics.com> diff --git a/doc/queue.n b/doc/queue.n deleted file mode 100644 index 7becec7..0000000 --- a/doc/queue.n +++ /dev/null @@ -1,62 +0,0 @@ -'\" -'\" 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 deleted file mode 100644 index 4c07e0b..0000000 --- a/doc/stack.n +++ /dev/null @@ -1,62 +0,0 @@ -'\" -'\" 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 deleted file mode 100644 index ff554df..0000000 --- a/doc/tree.n +++ /dev/null @@ -1,73 +0,0 @@ -'\" -'\" 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 deleted file mode 100644 index c1c4b4e..0000000 --- a/library/struct1.0/pkgIndex.tcl +++ /dev/null @@ -1,11 +0,0 @@ -# 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 deleted file mode 100644 index 22cf939..0000000 --- a/library/struct1.0/queue.tcl +++ /dev/null @@ -1,239 +0,0 @@ -# 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 deleted file mode 100644 index 50272b7..0000000 --- a/library/struct1.0/stack.tcl +++ /dev/null @@ -1,276 +0,0 @@ -# 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 deleted file mode 100644 index ecacdba..0000000 --- a/library/struct1.0/struct.tcl +++ /dev/null @@ -1,8 +0,0 @@ -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 deleted file mode 100644 index 3ec365c..0000000 --- a/tests/queue.test +++ /dev/null @@ -1,186 +0,0 @@ -# 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 deleted file mode 100644 index 6a5e3c5..0000000 --- a/tests/stackstruct.test +++ /dev/null @@ -1,228 +0,0 @@ -# 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 |