Use the powers of tcltest2 for good! Also add basic testing of disassmbler

(though not of its output format).

1 files changed, 86 insertions, 1 deletions

diff --git a/tests/compile.test b/tests/compile.test
index fe2deea..7d282ae 100644
--- a/tests/compile.test
+++ b/tests/compile.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: compile.test,v 1.48 2007/12/13 15:26:06 dgp Exp $
+# RCS: @(#) $Id: compile.test,v 1.49 2008/09/10 13:50:05 dkf Exp $
 
 package require tcltest 2
 namespace import -force ::tcltest::*
@@ -601,6 +601,91 @@ test compile-17.2 {Command interpretation binding for non-compiled code} -setup
     interp delete $i
 } -result substituted
 
+# This tests the supported parts of the unsupported [disassemble] command. It
+# does not check the format of disassembled bytecode though; that's liable to
+# change without warning.
+
+test compile-18.1 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble
+} -match glob -result {wrong # args: should be "*"}
+test compile-18.2 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble ?
+} -match glob -result {bad type "?": must be *}
+test compile-18.3 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble lambda
+} -match glob -result {wrong # args: should be "* lambda lambdaTerm"}
+test compile-18.4 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble lambda \{
+} -result "can't interpret \"\{\" as a lambda expression"
+test compile-18.5 {disassembler - basics} -body {
+    # Allow any string: the result format is not defined anywhere!
+    tcl::unsupported::disassemble lambda {{} {}}
+} -match glob -result *
+test compile-18.6 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble proc
+} -match glob -result {wrong # args: should be "* proc procName"}
+test compile-18.7 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble proc nosuchproc
+} -result {"nosuchproc" isn't a procedure}
+test compile-18.8 {disassembler - basics} -setup {
+    proc chewonthis {} {}
+} -body {
+    # Allow any string: the result format is not defined anywhere!
+    tcl::unsupported::disassemble proc chewonthis
+} -cleanup {
+    rename chewonthis {}
+} -match glob -result *
+test compile-18.9 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble script
+} -match glob -result {wrong # args: should be "* script script"}
+test compile-18.10 {disassembler - basics} -body {
+    # Allow any string: the result format is not defined anywhere!
+    tcl::unsupported::disassemble script {}
+} -match glob -result *
+test compile-18.11 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble method
+} -match glob -result {wrong # args: should be "* method className methodName"}
+test compile-18.12 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble method nosuchclass foo
+} -result {nosuchclass does not refer to an object}
+test compile-18.13 {disassembler - basics} -returnCodes error -setup {
+    oo::object create justanobject
+} -body {
+    tcl::unsupported::disassemble method justanobject foo
+} -cleanup {
+    justanobject destroy
+} -result {"justanobject" is not a class}
+test compile-18.14 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble method oo::object nosuchmethod
+} -result {unknown method "nosuchmethod"}
+test compile-18.15 {disassembler - basics} -setup {
+    oo::class create foo {method bar {} {}}
+} -body {
+    # Allow any string: the result format is not defined anywhere!
+    tcl::unsupported::disassemble method foo bar
+} -cleanup {
+    foo destroy
+} -match glob -result *
+test compile-18.16 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble objmethod
+} -match glob -result {wrong # args: should be "* objmethod objectName methodName"}
+test compile-18.17 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble objmethod nosuchobject foo
+} -result {nosuchobject does not refer to an object}
+test compile-18.18 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble objmethod oo::object nosuchmethod
+} -result {unknown method "nosuchmethod"}
+test compile-18.19 {disassembler - basics} -setup {
+    oo::object create foo
+    oo::objdefine foo {method bar {} {}}
+} -body {
+    # Allow any string: the result format is not defined anywhere!
+    tcl::unsupported::disassemble objmethod foo bar
+} -cleanup {
+    foo destroy
+} -match glob -result *
+# TODO sometime - check that bytecode from tbcload is *not* disassembled.
+
 # cleanup
 catch {rename p ""}
 catch {namespace delete test_ns_compile}