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 / listObj.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  6.5 KB  |  177 lines  |  [TEXT/ALFA]
  1. # Functionality covered: operation of the procedures in tclListObj.c that
  2. # implement the Tcl type manager for the list object type.
  3. #
  4. # This file contains a collection of tests for one or more of the Tcl
  5. # built-in commands. Sourcing this file into Tcl runs the tests and
  6. # generates output for errors.  No output means no errors were found.
  7. #
  8. # Copyright (c) 1995-1996 Sun Microsystems, Inc.
  9. #
  10. # See the file "license.terms" for information on usage and redistribution
  11. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12. #
  13. # SCCS: @(#) listObj.test 1.9 97/06/10 15:28:11
  14.  
  15. if {[info commands testobj] == {}} {
  16.     puts "This application hasn't been compiled with the \"testobj\""
  17.     puts "command, so I can't test the Tcl type and object support."
  18.     return
  19. }
  20.  
  21. if {[string compare test [info procs test]] == 1} then {source defs}
  22.  
  23. catch {unset x}
  24. test listobj-1.1 {Tcl_GetListObjType} {
  25.     set t [testobj types]
  26.     set first [string first "list" $t]
  27.     set result [expr {$first != -1}]
  28. } {1}
  29.  
  30. test listobj-2.1 {Tcl_ListObjForObjArray, use in lappend} {
  31.     catch {unset x}
  32.     list [lappend x 1 abc def] [lappend x 1 ghi jkl] $x
  33. } {{1 abc def} {1 abc def 1 ghi jkl} {1 abc def 1 ghi jkl}}
  34. test listobj-2.2 {Tcl_ListObjForObjArray, use in ObjInterpProc} {
  35.     proc return_args {args} {
  36.         return $args
  37.     }
  38.     list [return_args] [return_args x] [return_args x y]
  39. } {{} x {x y}}
  40.  
  41. test listobj-3.1 {Tcl_ListObjAppend, list conversion} {
  42.     catch {unset x}
  43.     list [lappend x 1 2 abc "long string"] $x
  44. } {{1 2 abc {long string}} {1 2 abc {long string}}}
  45. test listobj-3.2 {Tcl_ListObjAppend, list conversion} {
  46.     set x ""
  47.     list [lappend x first second] [lappend x third fourth] $x
  48. } {{first second} {first second third fourth} {first second third fourth}}
  49. test listobj-3.3 {Tcl_ListObjAppend, list conversion} {
  50.     set x "abc def"
  51.     list [lappend x first second] $x
  52. } {{abc def first second} {abc def first second}}
  53. test listobj-3.4 {Tcl_ListObjAppend, error in conversion} {
  54.     set x " \{"
  55.     list [catch {lappend x abc def} msg] $msg
  56. } {1 {unmatched open brace in list}}
  57. test listobj-3.5 {Tcl_ListObjAppend, force internal rep array to grow} {
  58.     set x ""
  59.     list [lappend x 1 1] [lappend x 2 2] [lappend x 3 3] [lappend x 4 4] \
  60.         [lappend x 5 5] [lappend x 6 6] [lappend x 7 7] [lappend x 8 8] $x
  61. } {{1 1} {1 1 2 2} {1 1 2 2 3 3} {1 1 2 2 3 3 4 4} {1 1 2 2 3 3 4 4 5 5} {1 1 2 2 3 3 4 4 5 5 6 6} {1 1 2 2 3 3 4 4 5 5 6 6 7 7} {1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8} {1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8}}
  62.  
  63. test listobj-4.1 {Tcl_ListObjAppendElement, list conversion} {
  64.     catch {unset x}
  65.     list [lappend x 1] $x
  66. } {1 1}
  67. test listobj-4.2 {Tcl_ListObjAppendElement, list conversion} {
  68.     set x ""
  69.     list [lappend x first] [lappend x second] $x
  70. } {first {first second} {first second}}
  71. test listobj-4.3 {Tcl_ListObjAppendElement, list conversion} {
  72.     set x "abc def"
  73.     list [lappend x first] $x
  74. } {{abc def first} {abc def first}}
  75. test listobj-4.4 {Tcl_ListObjAppendElement, error in conversion} {
  76.     set x " \{"
  77.     list [catch {lappend x abc} msg] $msg
  78. } {1 {unmatched open brace in list}}
  79. test listobj-4.5 {Tcl_ListObjAppendElement, force internal rep array to grow} {
  80.     set x ""
  81.     list [lappend x 1] [lappend x 2] [lappend x 3] [lappend x 4] \
  82.         [lappend x 5] [lappend x 6] [lappend x 7] [lappend x 8] $x
  83. } {1 {1 2} {1 2 3} {1 2 3 4} {1 2 3 4 5} {1 2 3 4 5 6} {1 2 3 4 5 6 7} {1 2 3 4 5 6 7 8} {1 2 3 4 5 6 7 8}}
  84.  
  85. test listobj-5.1 {Tcl_ListObjIndex, basic tests} {
  86.     lindex {a b c} 0
  87. } a
  88. test listobj-5.2 {Tcl_ListObjIndex, basic tests} {
  89.     lindex a 0
  90. } a
  91. test listobj-5.3 {Tcl_ListObjIndex, basic tests} {
  92.     lindex {a {b c d} x} 1
  93. } {b c d}
  94. test listobj-5.4 {Tcl_ListObjIndex, basic tests} {
  95.     lindex {a b c} 3
  96. } {}
  97. test listobj-5.5 {Tcl_ListObjIndex, basic tests} {
  98.     lindex {a b c} 100
  99. } {}
  100. test listobj-5.6 {Tcl_ListObjIndex, basic tests} {
  101.     lindex a 100
  102. } {}
  103. test listobj-5.7 {Tcl_ListObjIndex, basic tests} {
  104.     lindex {} -1
  105. } {}
  106. test listobj-5.8 {Tcl_ListObjIndex, error in conversion} {
  107.     set x " \{"
  108.     list [catch {lindex $x 0} msg] $msg
  109. } {1 {unmatched open brace in list}}
  110.  
  111. test listobj-6.1 {Tcl_ListObjLength} {
  112.     llength {a b c d}
  113. } 4
  114. test listobj-6.2 {Tcl_ListObjLength} {
  115.     llength {a b c {a b {c d}} d}
  116. } 5
  117. test listobj-6.3 {Tcl_ListObjLength} {
  118.     llength {}
  119. } 0
  120. test listobj-6.4 {Tcl_ListObjLength, convert from non-list} {
  121.     llength 123
  122. } 1
  123. test listobj-6.5 {Tcl_ListObjLength, error converting from non-list} {
  124.     list [catch {llength "a b c \{"} msg] $msg
  125. } {1 {unmatched open brace in list}}
  126. test listobj-6.6 {Tcl_ListObjLength, error converting from non-list} {
  127.     list [catch {llength "a {b}c"} msg] $msg
  128. } {1 {list element in braces followed by "c" instead of space}}
  129.  
  130. test listobj-7.1 {Tcl_ListObjReplace, conversion from non-list} {
  131.     lreplace 123 0 0 x
  132. } {x}
  133. test listobj-7.2 {Tcl_ListObjReplace, error converting from non-list} {
  134.     list [catch {lreplace "a b c \{" 1 1 x} msg] $msg
  135. } {1 {unmatched open brace in list}}
  136. test listobj-7.3 {Tcl_ListObjReplace, error converting from non-list} {
  137.     list [catch {lreplace "a {b}c" 1 2 x} msg] $msg
  138. } {1 {list element in braces followed by "c" instead of space}}
  139. test listobj-7.4 {Tcl_ListObjReplace, negative first element index} {
  140.     lreplace {1 2 3 4 5} -1 1 a
  141. } {a 3 4 5}
  142. test listobj-7.5 {Tcl_ListObjReplace, last element index >= num elems} {
  143.     lreplace {1 2 3 4 5} 3 7 a b c
  144. } {1 2 3 a b c}
  145. test listobj-7.6 {Tcl_ListObjReplace, first element index > last index} {
  146.     lreplace {1 2 3 4 5} 3 1 a b c
  147. } {1 2 3 a b c 4 5}
  148. test listobj-7.7 {Tcl_ListObjReplace, no new elements} {
  149.     lreplace {1 2 3 4 5} 1 1
  150. } {1 3 4 5}
  151. test listobj-7.8 {Tcl_ListObjReplace, shrink array in place} {
  152.     lreplace {1 2 3 4 5 6 7} 4 5
  153. } {1 2 3 4 7}
  154. test listobj-7.9 {Tcl_ListObjReplace, grow array in place} {
  155.     lreplace {1 2 3 4 5 6 7} 1 3 a b c d e
  156. } {1 a b c d e 5 6 7}
  157. test listobj-7.10 {Tcl_ListObjReplace, replace tail of array} {
  158.     lreplace {1 2 3 4 5 6 7} 3 6 a
  159. } {1 2 3 a}
  160. test listobj-7.11 {Tcl_ListObjReplace, must grow internal array} {
  161.     lreplace {1 2 3 4 5} 2 3 a b c d e f g h i j k l
  162. } {1 2 a b c d e f g h i j k l 5}
  163. test listobj-7.12 {Tcl_ListObjReplace, grow array, insert at start} {
  164.     lreplace {1 2 3 4 5} -1 -1 a b c d e f g h i j k l
  165. } {a b c d e f g h i j k l 1 2 3 4 5}
  166. test listobj-7.13 {Tcl_ListObjReplace, grow array, insert at end} {
  167.     lreplace {1 2 3 4 5} 4 1 a b c d e f g h i j k l
  168. } {1 2 3 4 a b c d e f g h i j k l 5}
  169.  
  170. test listobj-8.1 {SetListFromAny} {
  171.     lindex {0 foo\x00help 2} 1
  172. } "foo\x00help"
  173.  
  174. test listobj-9.1 {UpdateStringOfList} {
  175.     string length [list foo\x00help]
  176. } 8
  177.