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