Initial revision

1 files changed, 114 insertions, 0 deletions

diff --git a/tests/execute.test b/tests/execute.test
new file mode 100644
index 0000000..81fde45
--- /dev/null
+++ b/tests/execute.test
@@ -0,0 +1,114 @@
+# This file contains tests for the tclExecute.c source file. Tests appear
+# in the same order as the C code that they test. The set of tests is
+# currently incomplete since it currently includes only new tests for
+# code changed for the addition of Tcl namespaces. Other execution-
+# related tests appear in several other test files including
+# namespace.test, basic.test, eval.test, for.test, etc.
+#
+# Sourcing this file into Tcl runs the tests and generates output for
+# errors. No output means no errors were found.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) execute.test 1.5 97/08/12 11:16:31
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+catch {eval namespace delete [namespace children :: test_ns_*]}
+catch {rename foo ""}
+catch {unset x}
+catch {unset y}
+catch {unset msg}
+
+test execute-1.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    catch {unset x}
+    catch {unset y}
+    namespace eval test_ns_1 {
+        namespace export cmd1
+        proc cmd1 {args} {return "cmd1: $args"}
+        proc cmd2 {args} {return "cmd2: $args"}
+    }
+    namespace eval test_ns_1::test_ns_2 {
+        namespace import ::test_ns_1::*
+    }
+    set x "test_ns_1::"
+    set y "test_ns_2::"
+    list [namespace which -command ${x}${y}cmd1] \
+         [catch {namespace which -command ${x}${y}cmd2} msg] $msg \
+         [catch {namespace which -command ${x}${y}:cmd2} msg] $msg
+} {::test_ns_1::test_ns_2::cmd1 0 {} 0 {}}
+test execute-1.2 {Tcl_GetCommandFromObj, check if cached tclCmdNameType is invalid} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    catch {rename foo ""}
+    catch {unset l}
+    proc foo {} {
+        return "global foo"
+    }
+    namespace eval test_ns_1 {
+        proc whichFoo {} {
+            return [namespace which -command foo]
+        }
+    }
+    set l ""
+    lappend l [test_ns_1::whichFoo]
+    namespace eval test_ns_1 {
+        proc foo {} {
+            return "namespace foo"
+        }
+    }
+    lappend l [test_ns_1::whichFoo]
+    set l
+} {::foo ::test_ns_1::foo}
+test execute-1.3 {Tcl_GetCommandFromObj, command never found} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    catch {rename foo ""}
+    namespace eval test_ns_1 {
+        proc foo {} {
+            return "namespace foo"
+        }
+    }
+    namespace eval test_ns_1 {
+        proc foo {} {
+            return "namespace foo"
+        }
+    }
+    list [namespace eval test_ns_1 {namespace which -command foo}] \
+         [rename test_ns_1::foo ""] \
+         [catch {namespace eval test_ns_1 {namespace which -command foo}} msg] $msg
+} {::test_ns_1::foo {} 0 {}}
+
+test execute-2.1 {SetCmdNameFromAny, set cmd name to empty heap string if NULL} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    catch {unset l}
+    proc {} {} {return {}}
+    {}
+    set l {}
+    lindex {} 0
+    {}
+} {}
+
+test execute-3.1 {UpdateStringOfCmdName: called for duplicate of empty cmdName object} {
+    proc {} {} {}
+    proc { } {} {}
+    proc p {} {
+        set x {}
+        $x
+        append x { }
+        $x
+    }
+    p
+} {}
+
+catch {eval namespace delete [namespace children :: test_ns_*]}
+catch {rename foo ""}
+catch {rename p ""}
+catch {rename {} ""}
+catch {rename { } ""}
+catch {unset x}
+catch {unset y}
+catch {unset msg}
+concat {}