tests/array.test

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