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 / compile.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  3.8 KB  |  129 lines  |  [TEXT/ALFA]
  1. # This file contains tests for the file tclCompile.c.
  2. #
  3. # This file contains a collection of tests for one or more of the Tcl
  4. # built-in commands.  Sourcing this file into Tcl runs the tests and
  5. # generates output for errors.  No output means no errors were found.
  6. #
  7. # Copyright (c) 1997 by Sun Microsystems, Inc.
  8. #
  9. # See the file "license.terms" for information on usage and redistribution
  10. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11. #
  12. # SCCS: @(#) compile.test 1.7 97/08/12 13:34:13
  13.  
  14. if {[string compare test [info procs test]] == 1} then {source defs}
  15.  
  16. # The following tests are very incomplete, although the rest of the
  17. # test suite covers this file fairly well.
  18.  
  19. catch {rename p ""}
  20. catch {namespace delete test_ns_compile}
  21. catch {unset x}
  22. catch {unset y}
  23. catch {unset a}
  24.  
  25. test compile-1.1 {TclCompileString: look up cmds in proc ns, not current ns} {
  26.     catch {namespace delete test_ns_compile}
  27.     catch {unset x}
  28.     set x 123
  29.     namespace eval test_ns_compile {
  30.         proc set {args} {
  31.             global x
  32.             lappend x test_ns_compile::set
  33.         }
  34.         proc p {} {
  35.             set 0
  36.         }
  37.     }
  38.     list [test_ns_compile::p] [set x]
  39. } {{123 test_ns_compile::set} {123 test_ns_compile::set}}
  40. test compile-1.2 {TclCompileString, error result is reset if TclGetLong determines word isn't an integer} {
  41.     proc p {x} {info commands 3m}
  42.     list [catch {p} msg] $msg
  43. } {1 {no value given for parameter "x" to "p"}}
  44.  
  45. test compile-2.1 {TclCompileDollarVar: global scalar name with ::s} {
  46.     catch {unset x}
  47.     set x 123
  48.     list $::x [expr {[lsearch -exact [info globals] x] != 0}]
  49. } {123 1}
  50. test compile-2.2 {TclCompileDollarVar: global scalar name with ::s} {
  51.     catch {unset y}
  52.     proc p {} {
  53.         set ::y 789
  54.         return $::y
  55.     }
  56.     list [p] $::y [expr {[lsearch -exact [info globals] y] != 0}]
  57. } {789 789 1}
  58. test compile-2.3 {TclCompileDollarVar: global array name with ::s} {
  59.     catch {unset a}
  60.     set ::a(1) 2
  61.     list $::a(1) [set ::a($::a(1)) 3] $::a(2) [expr {[lsearch -exact [info globals] a] != 0}]
  62. } {2 3 3 1}
  63. test compile-2.4 {TclCompileDollarVar: global scalar name with ::s} {
  64.     catch {unset a}
  65.     proc p {} {
  66.         set ::a(1) 1
  67.         return $::a($::a(1))
  68.     }
  69.     list [p] $::a(1) [expr {[lsearch -exact [info globals] a] != 0}]
  70. } {1 1 1}
  71.  
  72. test compile-3.1 {TclCompileSetCmd: global scalar names with ::s} {
  73.     catch {unset x}
  74.     catch {unset y}
  75.     set x 123
  76.     proc p {} {
  77.         set ::y 789
  78.         return $::y
  79.     }
  80.     list $::x [expr {[lsearch -exact [info globals] x] != 0}] \
  81.          [p] $::y [expr {[lsearch -exact [info globals] y] != 0}]
  82. } {123 1 789 789 1}
  83. test compile-3.2 {TclCompileSetCmd: global array names with ::s} {
  84.     catch {unset a}
  85.     set ::a(1) 2
  86.     proc p {} {
  87.         set ::a(1) 1
  88.         return $::a($::a(1))
  89.     }
  90.     list $::a(1) [p] [set ::a($::a(1)) 3] $::a(1) [expr {[lsearch -exact [info globals] a] != 0}]
  91. } {2 1 3 3 1}
  92. test compile-3.3 {TclCompileSetCmd: namespace var names with ::s} {
  93.     catch {namespace delete test_ns_compile}
  94.     catch {unset x}
  95.     namespace eval test_ns_compile {
  96.         variable v hello
  97.         variable arr
  98.         set ::x $::test_ns_compile::v
  99.     set ::test_ns_compile::arr(1) 123
  100.     }
  101.     list $::x $::test_ns_compile::arr(1)
  102. } {hello 123}
  103.  
  104. test compile-4.1 {CollectArgInfo: binary data} {
  105.     list [catch "string length \000foo" msg] $msg
  106. } {0 4}
  107. test compile-4.2 {CollectArgInfo: binary data} {
  108.     list [catch "string length foo\000" msg] $msg
  109. } {0 4}
  110. test compile-4.3 {CollectArgInfo: handle "]" at end of command properly} {
  111.     set x ]
  112. } {]}
  113.  
  114. test compile-5.1 {UpdateStringOfByteCode: called for duplicate of compiled empty object} {
  115.     proc p {} {
  116.         set x {}
  117.         eval $x
  118.         append x { }
  119.         eval $x
  120.     }
  121.     p
  122. } {}
  123.  
  124. catch {rename p ""}
  125. catch {namespace delete test_ns_compile}
  126. catch {unset x}
  127. catch {unset y}
  128. catch {unset a}
  129.