summaryrefslogtreecommitdiff
path: root/tcl/tests/execute.test
diff options
context:
space:
mode:
Diffstat (limited to 'tcl/tests/execute.test')
-rw-r--r--tcl/tests/execute.test114
1 files changed, 114 insertions, 0 deletions
diff --git a/tcl/tests/execute.test b/tcl/tests/execute.test
new file mode 100644
index 00000000000..1abee4080d7
--- /dev/null
+++ b/tcl/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.
+#
+# RCS: @(#) $Id$
+
+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 {}