summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorericm <ericm>2000-02-05 03:20:20 (GMT)
committerericm <ericm>2000-02-05 03:20:20 (GMT)
commit09aefc91245d7700c0adc862b3bd105875776920 (patch)
tree71645d413988b58fe7d4461a547d16e1a7d92381 /tests
parent8bf5f65362060f021f96b45b48a62d9183deabb1 (diff)
downloadtcl-09aefc91245d7700c0adc862b3bd105875776920.zip
tcl-09aefc91245d7700c0adc862b3bd105875776920.tar.gz
tcl-09aefc91245d7700c0adc862b3bd105875776920.tar.bz2
* 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
Diffstat (limited to 'tests')
-rw-r--r--tests/queue.test186
-rw-r--r--tests/stackstruct.test228
2 files changed, 414 insertions, 0 deletions
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