1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
source [file dirname [info script]]/testing.tcl
needs cmd array
unset -nocomplain a
array set a {
1 one
2 two
22 "twenty two"
3 three
}
test array-1.1 "array exists - true" {
array exists a
} {1}
test array-1.2 "array exists - false" {
array exists b
} {0}
test array-1.3 "array size" {
array size a
} {4}
test array-1.4 "array size - nonexistant" {
array size b
} {0}
test array-1.5 "array get" {
set result {}
foreach {name value} [array get a] {
lappend result $name $value
}
lsort $result
} {1 2 22 3 one three {twenty two} two}
test array-1.6 "array get - pattern" {
set result {}
foreach {name value} [array get a 2*] {
lappend result $name $value
}
lsort $result
} {2 22 {twenty two} two}
test array-1.7 "array names" {
lsort [array names a]
} {1 2 22 3}
test array-1.8 "array get - pattern" {
lsort [array names a 2*]
} {2 22}
#set b $a
array set b [array get a]
test array-1.9 "array set - replace" {
array set b {22 twenty-two}
set b(22)
} {twenty-two}
test array-1.10 "array unset - pattern" {
array unset b 2*
lsort [array names b]
} {1 3}
test array-1.11 "array unset - all" {
array unset b
list [array size b] [array exists b]
} {0 0}
test array-1.12 "array set to invalid variable" -body {
unset -nocomplain a b
set a 1
array set a(1) {b c}
} -returnCodes error -result {can't set "a(1)": variable isn't array}
test array-1.13 "unset missing array element" -body {
unset -nocomplain a
set a(1) one
unset a(2)
} -returnCodes error -result {can't unset "a(2)": no such element in array}
test array-1.14 "access array via unset var" -body {
unset -nocomplain b
expr {$a($b) + 4}
} -returnCodes error -result {can't read "b": no such variable}
test array-1.15 "array unset non-variable" -body {
array unset nonvariable 4
} -result {}
test array-1.16 "array names non-variable" -body {
array names nonvariable
} -result {}
test array-1.17 "array get non-variable" -body {
array get nonvariable
} -result {}
# This seems like incorrect behaviour, but it matches tclsh
test array-1.18 "array size non-array" -body {
set x 1
array size x
} -result {0}
# This seems like incorrect behaviour, but it matches tclsh
test array-1.19 "array unset non-array" -body {
set x 6
array unset x 4
} -result {}
test array-1.20 "array stat" -body {
set output [array stat a]
regexp "entries in table.*buckets" $output
} -result {1}
test array-1.21 "array stat non-array" -body {
array stat badvariable
} -returnCodes error -result {"badvariable" isn't an array}
test array-1.22 "array set non-even args" -body {
array set x {
1 one
2 two
3
}
} -returnCodes error -result {list must have an even number of elements}
test array-1.23 "array exists non-array" -body {
set x 4
array exists x
} -result {0}
test array-2.1 {array -help} -constraints jim -body {
array -help
} -match glob -result {Usage: "array command ... ", where command is one of: *}
test array-2.2 {array -help get} -constraints jim -body {
array -help get
} -result {Usage: array get arrayName ?pattern?}
test array-2.3 {array -help ambiguous} -constraints jim -body {
array -help s
} -match glob -result {Usage: "array command ... ", where command is one of: *}
test array-2.3 {array -help nomatch} -constraints jim -body {
array -help unknown
} -match glob -result {Usage: "array command ... ", where command is one of: *}
test array-2.4 {array ambiguous} -constraints jim -body {
array s
} -returnCodes error -match glob -result {array, ambiguous command "s": should be *}
testreport
|
