[25] | 1 | # Commands covered: list |
---|
| 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 | # Copyright (c) 1998-1999 by Scriptics Corporation. |
---|
| 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 | # RCS: @(#) $Id: list.test,v 1.7 2003/07/24 16:05:24 dgp Exp $ |
---|
| 15 | |
---|
| 16 | if {[lsearch [namespace children] ::tcltest] == -1} { |
---|
| 17 | package require tcltest |
---|
| 18 | namespace import -force ::tcltest::* |
---|
| 19 | } |
---|
| 20 | |
---|
| 21 | # First, a bunch of individual tests |
---|
| 22 | |
---|
| 23 | test list-1.1 {basic tests} {list a b c} {a b c} |
---|
| 24 | test list-1.2 {basic tests} {list {a b} c} {{a b} c} |
---|
| 25 | test list-1.3 {basic tests} {list \{a b c} {\{a b c} |
---|
| 26 | test list-1.4 {basic tests} "list a{}} b{} c}" "a\\{\\}\\} b{} c\\}" |
---|
| 27 | test list-1.5 {basic tests} {list a\[ b\] } "{a\[} b\\]" |
---|
| 28 | test list-1.6 {basic tests} {list c\ d\t } "{c } {d\t}" |
---|
| 29 | test list-1.7 {basic tests} {list e\n f\$ } "{e\n} {f\$}" |
---|
| 30 | test list-1.8 {basic tests} {list g\; h\\} {{g;} h\\} |
---|
| 31 | test list-1.9 {basic tests} "list a\\\[} b\\\]} " "a\\\[\\\} b\\\]\\\}" |
---|
| 32 | test list-1.10 {basic tests} "list c\\\} d\\t} " "c\\} d\\t\\}" |
---|
| 33 | test list-1.11 {basic tests} "list e\\n} f\\$} " "e\\n\\} f\\$\\}" |
---|
| 34 | test list-1.12 {basic tests} "list g\\;} h\\\\} " "g\\;\\} {h\\}}" |
---|
| 35 | test list-1.13 {basic tests} {list a {{}} b} {a {{}} b} |
---|
| 36 | test list-1.14 {basic tests} {list a b xy\\} "a b xy\\\\" |
---|
| 37 | test list-1.15 {basic tests} "list a b\} e\\" "a b\\} e\\\\" |
---|
| 38 | test list-1.16 {basic tests} "list a b\}\\\$ e\\\$\\" "a b\\}\\\$ e\\\$\\\\" |
---|
| 39 | test list-1.17 {basic tests} {list a\f \{\f} "{a\f} \\\{\\f" |
---|
| 40 | test list-1.18 {basic tests} {list a\r \{\r} "{a\r} \\\{\\r" |
---|
| 41 | test list-1.19 {basic tests} {list a\v \{\v} "{a\v} \\\{\\v" |
---|
| 42 | test list-1.20 {basic tests} {list \"\}\{} "\\\"\\}\\{" |
---|
| 43 | test list-1.21 {basic tests} {list a b c\\\nd} "a b c\\\\\\nd" |
---|
| 44 | test list-1.22 {basic tests} {list "{ab}\\"} \\{ab\\}\\\\ |
---|
| 45 | test list-1.23 {basic tests} {list \{} "\\{" |
---|
| 46 | test list-1.24 {basic tests} {list} {} |
---|
| 47 | test list-1.25 {basic tests} {list # #} {{#} #} |
---|
| 48 | test list-1.26 {basic tests} {list #\{ #\{} {\#\{ #\{} |
---|
| 49 | |
---|
| 50 | # For the next round of tests create a list and then pick it apart |
---|
| 51 | # with "index" to make sure that we get back exactly what went in. |
---|
| 52 | |
---|
| 53 | set num 0 |
---|
| 54 | proc lcheck {testid a b c} { |
---|
| 55 | global num d |
---|
| 56 | set d [list $a $b $c] |
---|
| 57 | test ${testid}-0 {what goes in must come out} {lindex $d 0} $a |
---|
| 58 | test ${testid}-1 {what goes in must come out} {lindex $d 1} $b |
---|
| 59 | test ${testid}-2 {what goes in must come out} {lindex $d 2} $c |
---|
| 60 | } |
---|
| 61 | lcheck list-2.1 a b c |
---|
| 62 | lcheck list-2.2 "a b" c\td e\nf |
---|
| 63 | lcheck list-2.3 {{a b}} {} { } |
---|
| 64 | lcheck list-2.4 \$ \$ab ab\$ |
---|
| 65 | lcheck list-2.5 \; \;ab ab\; |
---|
| 66 | lcheck list-2.6 \[ \[ab ab\[ |
---|
| 67 | lcheck list-2.7 \\ \\ab ab\\ |
---|
| 68 | lcheck list-2.8 {"} {"ab} {ab"} ;#" Stupid emacs highlighting! |
---|
| 69 | lcheck list-2.9 {a b} { ab} {ab } |
---|
| 70 | lcheck list-2.10 a{ a{b \{ab |
---|
| 71 | lcheck list-2.11 a} a}b }ab |
---|
| 72 | lcheck list-2.12 a\\} {a \}b} {a \{c} |
---|
| 73 | lcheck list-2.13 xyz \\ 1\\\n2 |
---|
| 74 | lcheck list-2.14 "{ab}\\" "{ab}xy" abc |
---|
| 75 | |
---|
| 76 | concat {} |
---|
| 77 | |
---|
| 78 | # Check that tclListObj.c's SetListFromAny handles possible overlarge |
---|
| 79 | # string rep lengths in the source object. |
---|
| 80 | |
---|
| 81 | proc slowsort list { |
---|
| 82 | set result {} |
---|
| 83 | set last [expr [llength $list] - 1] |
---|
| 84 | while {$last > 0} { |
---|
| 85 | set minIndex [expr [llength $list] - 1] |
---|
| 86 | set min [lindex $list $last] |
---|
| 87 | set i [expr $minIndex-1] |
---|
| 88 | while {$i >= 0} { |
---|
| 89 | if {[string compare [lindex $list $i] $min] < 0} { |
---|
| 90 | set minIndex $i |
---|
| 91 | set min [lindex $list $i] |
---|
| 92 | } |
---|
| 93 | set i [expr $i-1] |
---|
| 94 | } |
---|
| 95 | set result [concat $result [list $min]] |
---|
| 96 | if {$minIndex == 0} { |
---|
| 97 | set list [lrange $list 1 end] |
---|
| 98 | } else { |
---|
| 99 | set list [concat [lrange $list 0 [expr $minIndex-1]] \ |
---|
| 100 | [lrange $list [expr $minIndex+1] end]] |
---|
| 101 | } |
---|
| 102 | set last [expr $last-1] |
---|
| 103 | } |
---|
| 104 | return [concat $result $list] |
---|
| 105 | } |
---|
| 106 | test list-3.1 {SetListFromAny and lrange/concat results} { |
---|
| 107 | slowsort {fred julie alex carol bill annie} |
---|
| 108 | } {alex annie bill carol fred julie} |
---|
| 109 | |
---|
| 110 | # cleanup |
---|
| 111 | ::tcltest::cleanupTests |
---|
| 112 | return |
---|