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 / proc.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  6.6 KB  |  164 lines  |  [TEXT/ALFA]
  1. # This file contains tests for the tclProc.c source file. Tests appear in
  2. # the same order as the C code that they test. The set of tests is
  3. # currently incomplete since it includes only new tests, in particular
  4. # tests for code changed for the addition of Tcl namespaces. Other
  5. # procedure-related tests appear in other test files such as proc-old.test.
  6. #
  7. # Sourcing this file into Tcl runs the tests and generates output for
  8. # errors.  No output means no errors were found.
  9. #
  10. # Copyright (c) 1997 Sun Microsystems, Inc.
  11. #
  12. # See the file "license.terms" for information on usage and redistribution
  13. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14. #
  15. # SCCS: @(#) proc.test 1.11 97/08/12 13:31:43
  16.  
  17. if {[string compare test [info procs test]] == 1} then {source defs}
  18.  
  19. catch {eval namespace delete [namespace children :: test_ns_*]}
  20. catch {rename p ""}
  21. catch {rename {} ""}
  22. catch {unset msg}
  23.  
  24. test proc-1.1 {Tcl_ProcObjCmd, put proc in namespace specified in name, if any} {
  25.     catch {eval namespace delete [namespace children :: test_ns_*]}
  26.     namespace eval test_ns_1 {
  27.         namespace eval baz {}
  28.     }
  29.     proc test_ns_1::baz::p {} {
  30.         return "p in [namespace current]"
  31.     }
  32.     list [test_ns_1::baz::p] \
  33.          [namespace eval test_ns_1 {baz::p}] \
  34.          [info commands test_ns_1::baz::*]
  35. } {{p in ::test_ns_1::baz} {p in ::test_ns_1::baz} ::test_ns_1::baz::p}
  36. test proc-1.2 {Tcl_ProcObjCmd, namespace specified in proc name must exist} {
  37.     catch {eval namespace delete [namespace children :: test_ns_*]}
  38.     list [catch {proc test_ns_1::baz::p {} {}} msg] $msg
  39. } {1 {can't create procedure "test_ns_1::baz::p": unknown namespace}}
  40. test proc-1.3 {Tcl_ProcObjCmd, empty proc name} {
  41.     catch {eval namespace delete [namespace children :: test_ns_*]}
  42.     proc :: {} {
  43.         return "empty called"
  44.     }
  45.     list [::] \
  46.          [info body {}]
  47. } {{empty called} {
  48.         return "empty called"
  49.     }}
  50. test proc-1.4 {Tcl_ProcObjCmd, simple proc name and proc defined in namespace} {
  51.     catch {eval namespace delete [namespace children :: test_ns_*]}
  52.     namespace eval test_ns_1 {
  53.         namespace eval baz {
  54.             proc p {} {
  55.                 return "p in [namespace current]"
  56.             }
  57.         }
  58.     }
  59.     list [test_ns_1::baz::p] \
  60.          [info commands test_ns_1::baz::*]
  61. } {{p in ::test_ns_1::baz} ::test_ns_1::baz::p}
  62. test proc-1.5 {Tcl_ProcObjCmd, qualified proc name and proc defined in namespace} {
  63.     catch {eval namespace delete [namespace children :: test_ns_*]}
  64.     namespace eval test_ns_1::baz {}
  65.     namespace eval test_ns_1 {
  66.         proc baz::p {} {
  67.             return "p in [namespace current]"
  68.         }
  69.     }
  70.     list [test_ns_1::baz::p] \
  71.          [info commands test_ns_1::baz::*] \
  72.          [namespace eval test_ns_1::baz {namespace which p}]
  73. } {{p in ::test_ns_1::baz} ::test_ns_1::baz::p ::test_ns_1::baz::p}
  74. test proc-1.6 {Tcl_ProcObjCmd, namespace code ignores single ":"s in middle or end of command names} {
  75.     catch {eval namespace delete [namespace children :: test_ns_*]}
  76.     namespace eval test_ns_1 {
  77.         proc q: {} {return "q:"}
  78.         proc value:at: {} {return "value:at:"}
  79.     }
  80.     list [namespace eval test_ns_1 {q:}] \
  81.          [namespace eval test_ns_1 {value:at:}] \
  82.          [test_ns_1::q:] \
  83.          [test_ns_1::value:at:] \
  84.          [lsort [info commands test_ns_1::*]] \
  85.          [namespace eval test_ns_1 {namespace which q:}] \
  86.          [namespace eval test_ns_1 {namespace which value:at:}]
  87. } {q: value:at: q: value:at: {::test_ns_1::q: ::test_ns_1::value:at:} ::test_ns_1::q: ::test_ns_1::value:at:}
  88. test proc-1.7 {Tcl_ProcObjCmd, check that formal parameter names are not array elements} {
  89.     catch {rename p ""}
  90.     list [catch {proc p {a(1) a(2)} { 
  91.             set z [expr $a(1)+$a(2)]
  92.             puts "$z=z, $a(1)=$a(1)"
  93.         }} msg] $msg
  94. } {1 {procedure "p" has formal parameter "a(1)" that is an array element}}
  95.  
  96. test proc-2.1 {TclFindProc, simple proc name and proc not in namespace} {
  97.     catch {eval namespace delete [namespace children :: test_ns_*]}
  98.     catch {rename p ""}
  99.     proc p {} {return "p in [namespace current]"}
  100.     info body p
  101. } {return "p in [namespace current]"}
  102. test proc-2.2 {TclFindProc, simple proc name and proc defined in namespace} {
  103.     catch {eval namespace delete [namespace children :: test_ns_*]}
  104.     namespace eval test_ns_1 {
  105.         namespace eval baz {
  106.             proc p {} {return "p in [namespace current]"}
  107.         }
  108.     }
  109.     namespace eval test_ns_1::baz {info body p}
  110. } {return "p in [namespace current]"}
  111. test proc-2.3 {TclFindProc, qualified proc name and proc defined in namespace} {
  112.     catch {eval namespace delete [namespace children :: test_ns_*]}
  113.     namespace eval test_ns_1::baz {}
  114.     namespace eval test_ns_1 {
  115.         proc baz::p {} {return "p in [namespace current]"}
  116.     }
  117.     namespace eval test_ns_1 {info body baz::p}
  118. } {return "p in [namespace current]"}
  119. test proc-2.4 {TclFindProc, global proc and executing in namespace} {
  120.     catch {eval namespace delete [namespace children :: test_ns_*]}
  121.     catch {rename p ""}
  122.     proc p {} {return "global p"}
  123.     namespace eval test_ns_1::baz {info body p}
  124. } {return "global p"}
  125.  
  126. test proc-3.1 {TclObjInterpProc, proc defined and executing in same namespace} {
  127.     catch {eval namespace delete [namespace children :: test_ns_*]}
  128.     proc p {} {return "p in [namespace current]"}
  129.     p
  130. } {p in ::}
  131. test proc-3.2 {TclObjInterpProc, proc defined and executing in same namespace} {
  132.     catch {eval namespace delete [namespace children :: test_ns_*]}
  133.     namespace eval test_ns_1::baz {
  134.         proc p {} {return "p in [namespace current]"}
  135.         p
  136.     }
  137. } {p in ::test_ns_1::baz}
  138. test proc-3.3 {TclObjInterpProc, proc defined and executing in different namespaces} {
  139.     catch {eval namespace delete [namespace children :: test_ns_*]}
  140.     catch {rename p ""}
  141.     proc p {} {return "p in [namespace current]"}
  142.     namespace eval test_ns_1::baz {
  143.         p
  144.     }
  145. } {p in ::}
  146. test proc-3.4 {TclObjInterpProc, procs execute in the namespace in which they were defined unless renamed into new namespace} {
  147.     catch {eval namespace delete [namespace children :: test_ns_*]}
  148.     catch {rename p ""}
  149.     namespace eval test_ns_1::baz {
  150.         proc p {} {return "p in [namespace current]"}
  151.         rename ::test_ns_1::baz::p ::p
  152.         list [p] [namespace which p]
  153.     }
  154. } {{p in ::} ::p}
  155. test proc-3.5 {TclObjInterpProc, any old result is reset before appending error msg about missing arguments} {
  156.     proc p {x} {info commands 3m}
  157.     list [catch {p} msg] $msg
  158. } {1 {no value given for parameter "x" to "p"}}
  159.  
  160. catch {eval namespace delete [namespace children :: test_ns_*]}
  161. catch {rename p ""}
  162. catch {rename {} ""}
  163. catch {unset msg}
  164.