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 / stringObj.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  6.6 KB  |  190 lines  |  [TEXT/ALFA]
  1. # Commands covered: none
  2. #
  3. # This file contains tests for the procedures in tclStringObj.c
  4. # that implement the Tcl type manager for the string type.
  5. #
  6. # Sourcing this file into Tcl runs the tests and generates output for
  7. # errors. No output means no errors were found.
  8. #
  9. # Copyright (c) 1995-1997 Sun Microsystems, Inc.
  10. #
  11. # See the file "license.terms" for information on usage and redistribution
  12. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13. #
  14. # @(#) stringObj.test 1.8 97/04/09 11:29:37
  15.  
  16. if {[info commands testobj] == {}} {
  17.     puts "This application hasn't been compiled with the \"testobj\""
  18.     puts "command, so I can't test the Tcl type and object support."
  19.     return
  20. }
  21.  
  22. if {[string compare test [info procs test]] == 1} then {source defs}
  23.  
  24. test stringObj-1.1 {string type registration} {
  25.     set t [testobj types]
  26.     set first [string first "string" $t]
  27.     set result [expr {$first != -1}]
  28. } {1}
  29.  
  30. test stringObj-2.1 {Tcl_NewStringObj} {
  31.     set result ""
  32.     lappend result [testobj freeallvars]
  33.     lappend result [teststringobj set 1 abcd]
  34.     lappend result [testobj type 1]
  35.     lappend result [testobj refcount 1]
  36. } {{} abcd string 2}
  37.  
  38. test stringObj-3.1 {Tcl_SetStringObj, existing "empty string" object} {
  39.     set result ""
  40.     lappend result [testobj freeallvars]
  41.     lappend result [testobj newobj 1]
  42.     lappend result [teststringobj set 1 xyz] ;# makes existing obj a string
  43.     lappend result [testobj type 1]
  44.     lappend result [testobj refcount 1]
  45. } {{} {} xyz string 2}
  46. test stringObj-3.2 {Tcl_SetStringObj, existing non-"empty string" object} {
  47.     set result ""
  48.     lappend result [testobj freeallvars]
  49.     lappend result [testintobj set 1 512]
  50.     lappend result [teststringobj set 1 foo]  ;# makes existing obj a string
  51.     lappend result [testobj type 1]
  52.     lappend result [testobj refcount 1]
  53. } {{} 512 foo string 2}
  54.  
  55. test stringObj-4.1 {Tcl_SetObjLength procedure, string gets shorter} {
  56.     testobj freeallvars
  57.     teststringobj set 1 test
  58.     teststringobj setlength 1 3
  59.     list [teststringobj length 1] [teststringobj length2 1] \
  60.         [teststringobj get 1]
  61. } {3 4 tes}
  62. test stringObj-4.2 {Tcl_SetObjLength procedure, string gets longer} {
  63.     testobj freeallvars
  64.     teststringobj set 1 abcdef
  65.     teststringobj setlength 1 10
  66.     list [teststringobj length 1] [teststringobj length2 1]
  67. } {10 10}
  68. test stringObj-4.3 {Tcl_SetObjLength procedure, string gets longer} {
  69.     testobj freeallvars
  70.     teststringobj set 1 abcdef
  71.     teststringobj append 1 xyzq -1
  72.     list [teststringobj length 1] [teststringobj length2 1] \
  73.         [teststringobj get 1]
  74. } {10 20 abcdefxyzq}
  75. test stringObj-4.4 {Tcl_SetObjLength procedure, "expty string", length 0} {
  76.     testobj freeallvars
  77.     testobj newobj 1
  78.     teststringobj setlength 1 0
  79.     list [teststringobj length2 1] [teststringobj get 1]
  80. } {0 {}}
  81.  
  82. test stringObj-5.1 {Tcl_AppendToObj procedure, type conversion} {
  83.     testobj freeallvars
  84.     testintobj set2 1 43
  85.     teststringobj append 1 xyz -1
  86.     teststringobj get 1
  87. } {43xyz}
  88. test stringObj-5.2 {Tcl_AppendToObj procedure, length calculation} {
  89.     testobj freeallvars
  90.     teststringobj set 1 {x y }
  91.     teststringobj append 1 bbCCddEE 4
  92.     teststringobj append 1 123 -1
  93.     teststringobj get 1
  94. } {x y bbCC123}
  95. test stringObj-5.3 {Tcl_AppendToObj procedure, reallocating space} {
  96.     testobj freeallvars
  97.     teststringobj set 1 xyz
  98.     teststringobj setlength 1 15
  99.     teststringobj setlength 1 2
  100.     set result {}
  101.     teststringobj append 1 1234567890123 -1
  102.     lappend result [teststringobj length 1] [teststringobj length2 1]
  103.     teststringobj setlength 1 10
  104.     teststringobj append 1 abcdef -1
  105.     lappend result [teststringobj length 1] [teststringobj length2 1] \
  106.         [teststringobj get 1]
  107. } {15 15 16 32 xy12345678abcdef}
  108.  
  109. test stringObj-6.1 {Tcl_AppendStringsToObj procedure, type conversion} {
  110.     testobj freeallvars
  111.     teststringobj set2 1 [list a b]
  112.     teststringobj appendstrings 1 xyz { 1234 } foo
  113.     teststringobj get 1
  114. } {a bxyz 1234 foo}
  115. test stringObj-6.2 {Tcl_AppendStringsToObj procedure, counting space} {
  116.     testobj freeallvars
  117.     teststringobj set 1 abc
  118.     teststringobj appendstrings 1
  119.     list [teststringobj length 1] [teststringobj get 1]
  120. } {3 abc}
  121. test stringObj-6.3 {Tcl_AppendStringsToObj procedure, counting space} {
  122.     testobj freeallvars
  123.     teststringobj set 1 abc
  124.     teststringobj appendstrings 1 {} {} {} {}
  125.     list [teststringobj length 1] [teststringobj get 1]
  126. } {3 abc}
  127. test stringObj-6.4 {Tcl_AppendStringsToObj procedure, counting space} {
  128.     testobj freeallvars
  129.     teststringobj set 1 abc
  130.     teststringobj appendstrings 1 { 123 } abcdefg
  131.     list [teststringobj length 1] [teststringobj get 1]
  132. } {15 {abc 123 abcdefg}}
  133. test stringObj-6.5 {Tcl_AppendStringsToObj procedure, don't double space if initial string empty} {
  134.     testobj freeallvars
  135.     testobj newobj 1
  136.     teststringobj appendstrings 1 123 abcdefg
  137.     list [teststringobj length 1] [teststringobj length2 1] [teststringobj get 1]
  138. } {10 10 123abcdefg}
  139. test stringObj-6.6 {Tcl_AppendStringsToObj procedure, space reallocation} {
  140.     testobj freeallvars
  141.     teststringobj set 1 abc
  142.     teststringobj setlength 1 10
  143.     teststringobj setlength 1 2
  144.     teststringobj appendstrings 1 34567890
  145.     list [teststringobj length 1] [teststringobj length2 1] \
  146.         [teststringobj get 1]
  147. } {10 10 ab34567890}
  148. test stringObj-6.7 {Tcl_AppendStringsToObj procedure, space reallocation} {
  149.     testobj freeallvars
  150.     teststringobj set 1 abc
  151.     teststringobj setlength 1 10
  152.     teststringobj setlength 1 2
  153.     teststringobj appendstrings 1 34567890x
  154.     list [teststringobj length 1] [teststringobj length2 1] \
  155.         [teststringobj get 1]
  156. } {11 22 ab34567890x}
  157. test stringObj-6.8 {Tcl_AppendStringsToObj procedure, object totally empty} {
  158.     testobj freeallvars
  159.     testobj newobj 1
  160.     teststringobj appendstrings 1 {}
  161.     list [teststringobj length2 1] [teststringobj get 1]
  162. } {0 {}}
  163.  
  164. test stringObj-7.1 {ConvertToStringType procedure} {
  165.     testobj freeallvars
  166.     teststringobj set2 1 [list a b]
  167.     teststringobj append 1 x -1
  168.     list [teststringobj length 1] [teststringobj length2 1] \
  169.         [teststringobj get 1]
  170. } {4 8 {a bx}}
  171. test stringObj-7.2 {ConvertToStringType procedure, null object} {
  172.     testobj freeallvars
  173.     testobj newobj 1
  174.     teststringobj appendstrings 1 {}
  175.     list [teststringobj length 1] [teststringobj length2 1] \
  176.         [teststringobj get 1]
  177. } {0 0 {}}
  178.  
  179. test stringObj-8.1 {DupStringInternalRep procedure} {
  180.     testobj freeallvars
  181.     teststringobj set 1 {}
  182.     teststringobj append 1 abcde -1
  183.     testobj duplicate 1 2
  184.     list [teststringobj length 1] [teststringobj length2 1] \
  185.         [teststringobj length 2] [teststringobj length2 2] \
  186.         [teststringobj get 2]
  187. } {5 10 5 5 abcde}
  188.  
  189. testobj freeallvars
  190.