home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tcl7.4 / tests / append.test < prev    next >
Encoding:
Text File  |  1994-12-18  |  4.1 KB  |  159 lines
  1. # Commands covered:  append lappend
  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) 1991-1993 The Regents of the University of California.
  8. # Copyright (c) 1994 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. # @(#) append.test 1.12 94/12/17 16:19:43
  14.  
  15. if {[string compare test [info procs test]] == 1} then {source defs}
  16.  
  17. catch {unset x}
  18. test append-1.1 {append command} {
  19.     catch {unset x}
  20.     list [append x 1 2 abc "long string"] $x
  21. } {{12abclong string} {12abclong string}}
  22. test append-1.2 {append command} {
  23.     set x ""
  24.     list [append x first] [append x second] [append x third] $x
  25. } {first firstsecond firstsecondthird firstsecondthird}
  26. test append-1.3 {append command} {
  27.     set x "abcd"
  28.     append x
  29. } abcd
  30.  
  31. test append-2.1 {long appends} {
  32.     set x ""
  33.     for {set i 0} {$i < 1000} {set i [expr $i+1]} {
  34.     append x "foobar "
  35.     }
  36.     set y "foobar"
  37.     set y "$y $y $y $y $y $y $y $y $y $y"
  38.     set y "$y $y $y $y $y $y $y $y $y $y"
  39.     set y "$y $y $y $y $y $y $y $y $y $y "
  40.     expr {$x == $y}
  41. } 1
  42.  
  43. test append-3.1 {append errors} {
  44.     list [catch {append} msg] $msg
  45. } {1 {wrong # args: should be "append varName ?value value ...?"}}
  46. test append-3.2 {append errors} {
  47.     set x ""
  48.     list [catch {append x(0) 44} msg] $msg
  49. } {1 {can't set "x(0)": variable isn't array}}
  50. test append-3.3 {append errors} {
  51.     catch {unset x}
  52.     list [catch {append x} msg] $msg
  53. } {1 {can't read "x": no such variable}}
  54.  
  55. test append-4.1 {lappend command} {
  56.     catch {unset x}
  57.     list [lappend x 1 2 abc "long string"] $x
  58. } {{1 2 abc {long string}} {1 2 abc {long string}}}
  59. test append-4.2 {lappend command} {
  60.     set x ""
  61.     list [lappend x first] [lappend x second] [lappend x third] $x
  62. } {first {first second} {first second third} {first second third}}
  63. test append-4.3 {lappend command} {
  64.     proc foo {} {
  65.     global x
  66.     set x old
  67.     unset x
  68.     lappend x new
  69.     }
  70.     set result [foo]
  71.     rename foo {}
  72.     set result
  73. } {new}
  74. test append-4.4 {lappend command} {
  75.     set x {}
  76.     lappend x \{\  abc
  77. } {\{\  abc}
  78. test append-4.5 {lappend command} {
  79.     set x {}
  80.     lappend x \{ abc
  81. } {\{ abc}
  82. test append-4.6 {lappend command} {
  83.     set x {1 2 3}
  84.     lappend x
  85. } {1 2 3}
  86. test append-4.7 {lappend command} {
  87.     set x "a\{"
  88.     lappend x abc
  89. } "a{ abc"
  90. test append-4.8 {lappend command} {
  91.     set x "\\\{"
  92.     lappend x abc
  93. } "\\{ abc"
  94. test append-4.9 {lappend command} {
  95.     set x " \{"
  96.     lappend x abc
  97. } " {abc"
  98. test append-4.10 {lappend command} {
  99.     set x "    \{"
  100.     lappend x abc
  101. } "    {abc"
  102. test append-4.11 {lappend command} {
  103.     set x "\{\{\{"
  104.     lappend x abc
  105. } "{{{abc"
  106. test append-4.12 {lappend command} {
  107.     set x "x \{\{\{"
  108.     lappend x abc
  109. } "x {{{abc"
  110. test append-4.13 {lappend command} {
  111.     set x "x\{\{\{"
  112.     lappend x abc
  113. } "x{{{ abc"
  114. test append-4.14 {lappend command} {
  115.     set x " "
  116.     lappend x abc
  117. } " abc"
  118. test append-4.15 {lappend command} {
  119.     set x "\\ "
  120.     lappend x abc
  121. } "\\  abc"
  122. test append-4.16 {lappend command} {
  123.     set x "x "
  124.     lappend x abc
  125. } "x abc"
  126.  
  127. proc check {var size} {
  128.     set l [llength $var]
  129.     if {$l != $size} {
  130.     return "length mismatch: should have been $size, was $l"
  131.     }
  132.     for {set i 0} {$i < $size} {set i [expr $i+1]} {
  133.     set j [lindex $var $i]
  134.     if {$j != "item $i"} {
  135.         return "element $i should have been \"item $i\", was \"$j\""
  136.     }
  137.     }
  138.     return ok
  139. }
  140. test append-5.1 {long lappends} {
  141.     set x ""
  142.     for {set i 0} {$i < 300} {set i [expr $i+1]} {
  143.     lappend x "item $i"
  144.     }
  145.     check $x 300
  146. } ok
  147.  
  148. test append-6.1 {lappend errors} {
  149.     list [catch {lappend} msg] $msg
  150. } {1 {wrong # args: should be "lappend varName ?value value ...?"}}
  151. test append-6.2 {lappend errors} {
  152.     set x ""
  153.     list [catch {lappend x(0) 44} msg] $msg
  154. } {1 {can't set "x(0)": variable isn't array}}
  155. test append-6.3 {lappend errors} {
  156.     catch {unset x}
  157.     list [catch {lappend x} msg] $msg
  158. } {1 {can't read "x": no such variable}}
  159.