home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / tests / execute.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  3.4 KB  |  115 lines  |  [TEXT/ALFA]
  1. # This file contains tests for the tclExecute.c source file. Tests appear
  2. # in the same order as the C code that they test. The set of tests is
  3. # currently incomplete since it currently includes only new tests for
  4. # code changed for the addition of Tcl namespaces. Other execution-
  5. # related tests appear in several other test files including
  6. # namespace.test, basic.test, eval.test, for.test, etc.
  7. #
  8. # Sourcing this file into Tcl runs the tests and generates output for
  9. # errors. No output means no errors were found.
  10. #
  11. # Copyright (c) 1997 Sun Microsystems, Inc.
  12. #
  13. # See the file "license.terms" for information on usage and redistribution
  14. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  15. #
  16. # SCCS: @(#) execute.test 1.5 97/08/12 11:16:31
  17.  
  18. if {[string compare test [info procs test]] == 1} then {source defs}
  19.  
  20. catch {eval namespace delete [namespace children :: test_ns_*]}
  21. catch {rename foo ""}
  22. catch {unset x}
  23. catch {unset y}
  24. catch {unset msg}
  25.  
  26. test execute-1.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} {
  27.     catch {eval namespace delete [namespace children :: test_ns_*]}
  28.     catch {unset x}
  29.     catch {unset y}
  30.     namespace eval test_ns_1 {
  31.         namespace export cmd1
  32.         proc cmd1 {args} {return "cmd1: $args"}
  33.         proc cmd2 {args} {return "cmd2: $args"}
  34.     }
  35.     namespace eval test_ns_1::test_ns_2 {
  36.         namespace import ::test_ns_1::*
  37.     }
  38.     set x "test_ns_1::"
  39.     set y "test_ns_2::"
  40.     list [namespace which -command ${x}${y}cmd1] \
  41.          [catch {namespace which -command ${x}${y}cmd2} msg] $msg \
  42.          [catch {namespace which -command ${x}${y}:cmd2} msg] $msg
  43. } {::test_ns_1::test_ns_2::cmd1 0 {} 0 {}}
  44. test execute-1.2 {Tcl_GetCommandFromObj, check if cached tclCmdNameType is invalid} {
  45.     catch {eval namespace delete [namespace children :: test_ns_*]}
  46.     catch {rename foo ""}
  47.     catch {unset l}
  48.     proc foo {} {
  49.         return "global foo"
  50.     }
  51.     namespace eval test_ns_1 {
  52.         proc whichFoo {} {
  53.             return [namespace which -command foo]
  54.         }
  55.     }
  56.     set l ""
  57.     lappend l [test_ns_1::whichFoo]
  58.     namespace eval test_ns_1 {
  59.         proc foo {} {
  60.             return "namespace foo"
  61.         }
  62.     }
  63.     lappend l [test_ns_1::whichFoo]
  64.     set l
  65. } {::foo ::test_ns_1::foo}
  66. test execute-1.3 {Tcl_GetCommandFromObj, command never found} {
  67.     catch {eval namespace delete [namespace children :: test_ns_*]}
  68.     catch {rename foo ""}
  69.     namespace eval test_ns_1 {
  70.         proc foo {} {
  71.             return "namespace foo"
  72.         }
  73.     }
  74.     namespace eval test_ns_1 {
  75.         proc foo {} {
  76.             return "namespace foo"
  77.         }
  78.     }
  79.     list [namespace eval test_ns_1 {namespace which -command foo}] \
  80.          [rename test_ns_1::foo ""] \
  81.          [catch {namespace eval test_ns_1 {namespace which -command foo}} msg] $msg
  82. } {::test_ns_1::foo {} 0 {}}
  83.  
  84. test execute-2.1 {SetCmdNameFromAny, set cmd name to empty heap string if NULL} {
  85.     catch {eval namespace delete [namespace children :: test_ns_*]}
  86.     catch {unset l}
  87.     proc {} {} {return {}}
  88.     {}
  89.     set l {}
  90.     lindex {} 0
  91.     {}
  92. } {}
  93.  
  94. test execute-3.1 {UpdateStringOfCmdName: called for duplicate of empty cmdName object} {
  95.     proc {} {} {}
  96.     proc { } {} {}
  97.     proc p {} {
  98.         set x {}
  99.         $x
  100.         append x { }
  101.         $x
  102.     }
  103.     p
  104. } {}
  105.  
  106. catch {eval namespace delete [namespace children :: test_ns_*]}
  107. catch {rename foo ""}
  108. catch {rename p ""}
  109. catch {rename {} ""}
  110. catch {rename { } ""}
  111. catch {unset x}
  112. catch {unset y}
  113. catch {unset msg}
  114. concat {}
  115.