summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorKevin B Kenny <kennykb@acm.org>2010-10-28 19:40:12 (GMT)
committerKevin B Kenny <kennykb@acm.org>2010-10-28 19:40:12 (GMT)
commitdd826cedb13503968999c10b4b26450f140a72ff (patch)
treec7033f29d3be00edb51688bd7994776ff1d98a18 /tests
parentd9008e316e4915e8fef1f292c59446c15560c022 (diff)
downloadtcl-dd826cedb13503968999c10b4b26450f140a72ff.zip
tcl-dd826cedb13503968999c10b4b26450f140a72ff.tar.gz
tcl-dd826cedb13503968999c10b4b26450f140a72ff.tar.bz2
* generic/tclAssembly.c:
* tests/assembly.test (assemble-31.*): Added jump tables.
Diffstat (limited to 'tests')
-rw-r--r--tests/assemble.test139
1 files changed, 139 insertions, 0 deletions
diff --git a/tests/assemble.test b/tests/assemble.test
index c5898c1..7a05137 100644
--- a/tests/assemble.test
+++ b/tests/assemble.test
@@ -1,3 +1,16 @@
+# assemble.test --
+#
+# Test suite for the 'tcl::unsupported::assemble' command
+#
+# Copyright (c) 2010 by Ozgur Dogan Ugurlu.
+# Copyright (c) 2010 by Kevin B. Kenny.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: assemble.test,v 1.1.2.15 2010/10/28 19:40:13 kennykb Exp $
+#-----------------------------------------------------------------------------
+
# Commands covered: assemble
if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -3021,6 +3034,8 @@ test assemble-29.7 {regexp} {
-result 1
}
+# assemble-30 - Catches
+
test assemble-30.1 {simplest possible catch} {
-body {
proc x {} {
@@ -3096,6 +3111,91 @@ test assemble-30.3 {embedded catches} {
-cleanup {rename x {}}
}
+# assemble-31 - Jump tables
+
+test assemble-31.1 {jumpTable, wrong # args} {
+ -body {
+ assemble {jumpTable}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-31.2 {jumpTable, wrong # args} {
+ -body {
+ assemble {jumpTable too many}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-31.3 {jumpTable - bad subst} {
+ -body {
+ assemble {jumpTable $foo}
+ }
+ -returnCodes error
+ -match glob
+ -result {assembly code may not contain substitutions}
+}
+test assemble-31.4 {jumptable - not a list} {
+ -body {
+ assemble {jumpTable \{rubbish}
+ }
+ -returnCodes error
+ -result {unmatched open brace in list}
+}
+test assemble-31.5 {jumpTable, badly structured} {
+ -body {
+ list [catch {assemble {
+ # line 2
+ jumpTable {one two three};# line 3
+ }} result] \
+ $result $::errorCode $::errorInfo
+ }
+ -match glob
+ -result {1 {jump table must have an even number of list elements} {TCL ASSEM BADJUMPTABLE} {jump table must have an even number of list elements*("assemble" body, line 3)*}}
+}
+test assemble-31.6 {jumpTable, missing symbol} {
+ -body {
+ list [catch {assemble {
+ # line 2
+ jumpTable {1 a};# line 3
+ }} result] \
+ $result $::errorCode $::errorInfo
+ }
+ -match glob
+ -result {1 {undefined label "a"} {TCL ASSEM NOLABEL a} {undefined label "a"*("assemble" body, line 3)*}}
+}
+
+test assemble-31.7 {jumptable, actual example} {
+ -setup {
+ proc x {} {
+ set result {}
+ for {set i 0} {$i < 5} {incr i} {
+ lappend result [assemble {
+ load i
+ jumpTable {1 @one 2 @two 3 @three}
+ push {none of the above}
+ jump @done
+ label @one
+ push one
+ jump @done
+ label @two
+ push two
+ jump @done
+ label @three
+ push three
+ label @done
+ }]
+ }
+ set tcl_traceCompile 2
+ set result
+ }
+ }
+ -body x
+ -result {{none of the above} one two three {none of the above}}
+ -cleanup {set tcl_traceCompile 0; rename x {}}
+}
test assemble-40.1 {unbalanced stack} {
-body {
@@ -3164,6 +3264,45 @@ test assemble-41.1 {Inconsistent stack usage} {*}{
("assemble" body, line 10)*}
}
+test assemble-41.2 {Inconsistent stack, jumptable and default} {
+ -body {
+ proc x {y} {
+ assemble {
+ load y
+ jumpTable {0 else}
+ push 0
+ label else
+ pop
+ }
+ }
+ catch {x 1}
+ set errorInfo
+ }
+ -match glob
+ -result {inconsistent stack depths on two execution paths
+ ("assemble" body, line 6)*}
+}
+
+test assemble-41.3 {Inconsistent stack, two legs of jumptable} {
+ -body {
+ proc x {y} {
+ assemble {
+ load y
+ jumpTable {0 no 1 yes}
+ label no
+ push 0
+ label yes
+ pop
+ }
+ }
+ catch {x 1}
+ set errorInfo
+ }
+ -match glob
+ -result {inconsistent stack depths on two execution paths
+ ("assemble" body, line 7)*}
+}
+
test assemble-50.1 {Ulam's 3n+1 problem, TAL implementation} {
-body {
proc ulam {n} {