languages/tcl/t/cmd_array.t

   1 #!perl
   2
   3 # Copyright (C) 2004-2008, The Perl Foundation.
   4 # $Id$
   5
   6 # the following lines re-execute this as a tcl script
   7 # the \ at the end of these lines makes them a comment in tcl \
   8 use lib qw(languages/tcl/lib tcl/lib lib ../lib ../../lib); # \
   9 use Tcl::Test; #\
  10 __DATA__
  11
  12 source lib/test_more.tcl
  13 plan 50
  14
  15 eval_is {array}\
  16   {wrong # args: should be "array option arrayName ?arg ...?"}\
  17   {array, no args}
  18
  19 eval_is {array exists}\
  20   {wrong # args: should be "array option arrayName ?arg ...?"}\
  21   {array, good subcommand, no array}
  22
  23 eval_is {array bork foo}\
  24   {bad option "bork": must be anymore, donesearch, exists, get, names, nextelement, set, size, startsearch, statistics, or unset}\
  25   {array, bad subcommand, bad arary}
  26
  27 eval_is {
  28  set b(c) 2
  29  array exists b
  30 } 1 {array exists yes}
  31
  32 eval_is {
  33  set a 2
  34  array exists a
  35 } 0 {array exists no}
  36
  37 eval_is {array exists q} 0 {array exists missing}
  38
  39 eval_is {array exists a b}\
  40   {wrong # args: should be "array exists arrayName"}\
  41   {array exists too many args}
  42
  43 eval_is {
  44   proc test {} {
  45       array set foo [list 1 2 3 4]
  46       return [array exists foo]
  47   }
  48   test
  49 } 1 {array exists lexical}
  50
  51 eval_is {array size a b}\
  52   {wrong # args: should be "array size arrayName"}\
  53   {array size too many args}
  54
  55 eval_is {
  56  catch {unset a}
  57  set a(1) 1
  58  array size a
  59 } 1 {array size 1}
  60
  61 eval_is {
  62  catch {unset a}
  63  set a(1) 1; set a(2) 2
  64  array size a
  65 } 2 {array size 2}
  66
  67 eval_is {
  68  catch {unset a}
  69  set a 1
  70  array size a
  71 } 0 {}
  72
  73 eval_is {
  74  catch {unset a}
  75  array set a [list a b]
  76  set a(a)
  77 } b {array set list}
  78
  79 eval_is {
  80  catch {unset a}
  81  array set a [list a b c d e f]
  82  list $a(a) $a(c) $a(e)
  83 } {b d f} {array set multi list}
  84
  85 eval_is {
  86  catch {unset a}
  87  set a(a) b
  88  array set a [list c d e f]
  89  list $a(a) $a(c) $a(e)
  90 } {b d f} {array set preserve old values}
  91
  92 eval_is {
  93  catch {unset a}
  94  array set a {a b}
  95  set a(a)
  96 } b {array set}
  97
  98 eval_is {
  99  catch {unset a}
 100  array set a {a b c d e f}
 101  list $a(a) $a(c) $a(e)
 102 } {b d f} {array set multi}
 103
 104 eval_is {array set a a}\
 105   {list must have an even number of elements}\
 106   {array set uneven}
 107
 108 eval_is {array set a [list a b]} \
 109   {}\
 110   {array set return value}
 111
 112 eval_is {
 113   catch {unset a}
 114   set a 44
 115   array set a {1 2 3 4}
 116 } {can't set "a(1)": variable isn't array}\
 117   {array set not array}
 118
 119 eval_is {
 120   catch {unset a}
 121   array set a {}
 122   array get a
 123 } {} {array set with empty list}
 124
 125 eval_is {
 126   catch {unset a}
 127   array set a [list a b]
 128   array get a
 129 } {a b} {array get}
 130
 131 eval_is {
 132   catch {unset a}
 133   array set a [list a {b c}]
 134   array get a
 135 } {a {b c}} {array get, insure list results}
 136
 137 eval_is {
 138   catch {unset a}
 139   array set a [list a b c d]
 140   array get a a
 141 } {a b} {array get with pattern}
 142
 143 eval_is {
 144   catch {unset a}
 145   array set a [list apple 1 orange 2 aardvark 3]
 146   lsort [array get a a*]
 147 } {1 3 aardvark apple}\
 148   {array get, with pattern}
 149
 150 eval_is {
 151   catch {unset a}
 152   array set a [list apple 1 orange 2 aardvark 3]
 153   array get a zippy*
 154 } {} {array get, with bad pattern}
 155
 156 eval_is {
 157   catch {unset a}
 158   array get a
 159 } {} {array get, no array}
 160
 161 eval_is {
 162   catch {unset a}
 163   set a 2
 164   array get a
 165 } {} {array get, non array}
 166
 167 eval_is {
 168   catch {unset a}
 169   array get a a
 170 } {} {array get, bad array with pattern}
 171
 172 eval_is {array get a b c}\
 173   {wrong # args: should be "array get arrayName ?pattern?"}\
 174   {array get, too many args}
 175
 176 eval_is {
 177   catch {unset a}
 178   array set a [list a b]
 179   list [array unset a] [array get a]
 180 } {{} {}} {array unset, effect & return value}
 181
 182 eval_is {
 183   catch {unset a}
 184   array set a [list a b c d]
 185   list [array unset a a] [array get a]
 186 } {{} {c d}} {array unset, with pattern & return value}
 187
 188 eval_is {
 189   catch {unset a}
 190   array set a [list apple 1 orange 2 aardvark 3]
 191   list [array unset a a*] [array get a]
 192 } {{} {orange 2}} {array unset with pattern}
 193
 194 eval_is {
 195   catch {unset a}
 196   array set a [list apple 1 orange 2 aardvark 3]
 197   list [array unset a zippy*] [lsort [array get a]]
 198 } {{} {1 2 3 aardvark apple orange}}\
 199   {array unset, with bad pattern}
 200
 201 eval_is {
 202   catch {unset a}
 203   array unset a
 204 } {} {array unset, bad array}
 205
 206 eval_is {
 207   catch {unset a}
 208   array unset a monkey*
 209 } {} {array unset, bad array, pattern}
 210
 211 eval_is {
 212   array unset monkey my monkey monkey
 213 } {wrong # args: should be "array unset arrayName ?pattern?"}\
 214   {array unset, too many args}
 215
 216 eval_is {
 217   catch {unset a}
 218   array names a
 219 } {} {array names, no array}
 220
 221 eval_is {
 222   catch {unset a}
 223   array set a [list {b c} a]
 224   array names a
 225 } {{b c}} {array names, insure list results}
 226
 227 eval_is {array names a b c} \
 228   {bad option "b": must be -exact, -glob, or -regexp} \
 229   {array names, bad option}
 230
 231 eval_is {array names a b c d}\
 232   {wrong # args: should be "array names arrayName ?mode? ?pattern?"}\
 233   {array names, too many args}
 234
 235 eval_is {
 236   catch {unset a}
 237   set a(monkey) see
 238   array names a
 239 } {monkey} {array names, no pattern}
 240
 241 eval_is {
 242   catch {unset a}
 243   set a(monkey1) see
 244   set a(monkey2) do
 245   array names a monkey*
 246 } {monkey1 monkey2}\
 247   {array names, default glob pattern}
 248
 249 eval_is {
 250   catch {unset a}
 251   set a(monkey1) see
 252   set a(monkey2) do
 253   array names a cat*
 254 } {} {array names, default glob pattern failure}
 255
 256 eval_is {
 257   catch {unset a}
 258   set a(monkey1) see
 259   set a(monkey2) do
 260   array names a -glob monkey*
 261 } {monkey1 monkey2} {array names, explicit glob pattern}
 262
 263 eval_is {
 264   catch {unset a}
 265   set a(monkey1) see
 266   set a(monkey2) do
 267   array names a -glob cat*
 268 } {} {array names, explicit glob pattern failure}
 269
 270 eval_is {
 271   catch {unset a}
 272   set a(monkey1) see
 273   set a(monkey2) do
 274   array names a -exact monkey1
 275 } {monkey1} {array names, explicit exact match}
 276
 277 eval_is {
 278   catch {unset a}
 279   set a(monkey1) see
 280   set a(monkey2) do
 281   array names a -exact cat5
 282 } {} {array names, explicit exact match failure}
 283
 284 eval_is {
 285   catch {unset a}
 286   set a(monkey1) see
 287   set a(monkey2) do
 288   set a(ferret)  don't
 289   array names a -regexp ^mon.*
 290 } {monkey1 monkey2} {array names, explicit regexp match}
 291
 292 eval_is {
 293   catch {unset a}
 294   set a(monkey1) see
 295   set a(monkey2) do
 296   array names a -regexp cat
 297 } {} {array names, explicit regexp match failure}