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 © 1991-1993 The Regents of the University of California. 8# Copyright © 1994 Sun Microsystems, Inc. 9# Copyright © 1998-1999 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 14if {"::tcltest" ni [namespace children]} { 15 package require tcltest 2.5 16 namespace import -force ::tcltest::* 17} 18 19# First, a bunch of individual tests 20 21test list-1.1 {basic tests} {list a b c} {a b c} 22test list-1.2 {basic tests} {list {a b} c} {{a b} c} 23test list-1.3 {basic tests} {list \{a b c} {\{a b c} 24test list-1.4 {basic tests} "list a{}} b{} c}" "a\\{\\}\\} b{} c\\}" 25test list-1.5 {basic tests} {list a\[ b\] } "{a\[} b\\]" 26test list-1.6 {basic tests} {list c\ d\t } "{c } {d\t}" 27test list-1.7 {basic tests} {list e\n f\$ } "{e\n} {f\$}" 28test list-1.8 {basic tests} {list g\; h\\} {{g;} h\\} 29test list-1.9 {basic tests} "list a\\\[} b\\\]} " "a\\\[\\\} b\\\]\\\}" 30test list-1.10 {basic tests} "list c\\\} d\\t} " "c\\} d\\t\\}" 31test list-1.11 {basic tests} "list e\\n} f\\$} " "e\\n\\} f\\$\\}" 32test list-1.12 {basic tests} "list g\\;} h\\\\} " "g\\;\\} {h\\}}" 33test list-1.13 {basic tests} {list a {{}} b} {a {{}} b} 34test list-1.14 {basic tests} {list a b xy\\} "a b xy\\\\" 35test list-1.15 {basic tests} "list a b\} e\\" "a b\\} e\\\\" 36test list-1.16 {basic tests} "list a b\}\\\$ e\\\$\\" "a b\\}\\\$ e\\\$\\\\" 37test list-1.17 {basic tests} {list a\f \{\f} "{a\f} \\\{\\f" 38test list-1.18 {basic tests} {list a\r \{\r} "{a\r} \\\{\\r" 39test list-1.19 {basic tests} {list a\v \{\v} "{a\v} \\\{\\v" 40test list-1.20 {basic tests} {list \"\}\{} "\\\"\\}\\{" 41test list-1.21 {basic tests} {list a b c\\\nd} "a b c\\\\\\nd" 42test list-1.22 {basic tests} {list "{ab}\\"} \\{ab\\}\\\\ 43test list-1.23 {basic tests} {list \{} "\\{" 44test list-1.24 {basic tests} {list} {} 45test list-1.25 {basic tests} {list # #} {{#} #} 46test list-1.26 {basic tests} {list #\{ #\{} {\#\{ #\{} 47test list-1.27 {basic null treatment} { 48 set l [list "" "\x00" "\x00\x00"] 49 set e "{} \x00 \x00\x00" 50 string equal $l $e 51} 1 52test list-1.28 {basic null treatment} { 53 set result "\x00a\x00b" 54 list $result [string length $result] 55} "\x00a\x00b 4" 56test list-1.29 {basic null treatment} { 57 set result "\x00a\x00b" 58 set srep "$result 4" 59 set lrep [list $result [string length $result]] 60 string equal $srep $lrep 61} 1 62test list-1.30 {basic null treatment} { 63 set l [list "\x00abc" "xyz"] 64 set e "\x00abc xyz" 65 string equal $l $e 66} 1 67 68# For the next round of tests create a list and then pick it apart 69# with "index" to make sure that we get back exactly what went in. 70 71set num 0 72proc lcheck {testid a b c} { 73 global num d 74 set d [list $a $b $c] 75 test ${testid}-0 {what goes in must come out} {lindex $d 0} $a 76 test ${testid}-1 {what goes in must come out} {lindex $d 1} $b 77 test ${testid}-2 {what goes in must come out} {lindex $d 2} $c 78} 79lcheck list-2.1 a b c 80lcheck list-2.2 "a b" c\td e\nf 81lcheck list-2.3 {{a b}} {} { } 82lcheck list-2.4 \$ \$ab ab\$ 83lcheck list-2.5 \; \;ab ab\; 84lcheck list-2.6 \[ \[ab ab\[ 85lcheck list-2.7 \\ \\ab ab\\ 86lcheck list-2.8 {"} {"ab} {ab"} ;#" Stupid emacs highlighting! 87lcheck list-2.9 {a b} { ab} {ab } 88lcheck list-2.10 a{ a{b \{ab 89lcheck list-2.11 a} a}b }ab 90lcheck list-2.12 a\\} {a \}b} {a \{c} 91lcheck list-2.13 xyz \\ 1\\\n2 92lcheck list-2.14 "{ab}\\" "{ab}xy" abc 93 94concat {} 95 96# Check that tclListObj.c's SetListFromAny handles possible overlarge 97# string rep lengths in the source object. 98 99proc slowsort list { 100 set result {} 101 set last [expr {[llength $list] - 1}] 102 while {$last > 0} { 103 set minIndex [expr {[llength $list] - 1}] 104 set min [lindex $list $last] 105 set i [expr {$minIndex - 1}] 106 while {$i >= 0} { 107 if {[string compare [lindex $list $i] $min] < 0} { 108 set minIndex $i 109 set min [lindex $list $i] 110 } 111 incr i -1 112 } 113 set result [concat $result [list $min]] 114 if {$minIndex == 0} { 115 set list [lrange $list 1 end] 116 } else { 117 set list [concat [lrange $list 0 [expr {$minIndex - 1}]] \ 118 [lrange $list [expr {$minIndex + 1}] end]] 119 } 120 set last [expr {$last - 1}] 121 } 122 return [concat $result $list] 123} 124test list-3.1 {SetListFromAny and lrange/concat results} { 125 slowsort {fred julie alex carol bill annie} 126} {alex annie bill carol fred julie} 127 128test list-4.1 {Bug 3173086} { 129 string is list "{[list \\\\\}]}" 130} 1 131test list-4.2 {Bug 35a8f1c04a, check correct str-rep} { 132 set result {} 133 foreach i { 134 {#"} {#"""} {#"""""""""""""""} 135 "#\"{" "#\"\"\"{" "#\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\{" 136 "#\"}" "#\"\"\"}" "#\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\}" 137 } { 138 set list [list $i] 139 set list [string trim " $list "] 140 if {[llength $list] > 1 || $i ne [lindex $list 0]} { 141 lappend result "wrong string-representation of list by '$i', length: [llength $list], list: '$list'" 142 } 143 } 144 set result [join $result \n] 145} {} 146test list-4.3 {Bug 35a8f1c04a, check correct string length} { 147 string length [list #""] 148} 5 149 150# cleanup 151::tcltest::cleanupTests 152return 153