1#
2# arrayproc.test
3#
4# Tests for tcl.tlib array routines.
5#---------------------------------------------------------------------------
6# Copyright 1992-1999 Karl Lehenbauer and Mark Diekhans.
7#
8# Permission to use, copy, modify, and distribute this software and its
9# documentation for any purpose and without fee is hereby granted, provided
10# that the above copyright notice appear in all copies.  Karl Lehenbauer and
11# Mark Diekhans make no representations about the suitability of this
12# software for any purpose.  It is provided "as is" without express or
13# implied warranty.
14#------------------------------------------------------------------------------
15# $Id: arrayproc.test,v 1.2 2002/04/02 02:29:43 hobbs Exp $
16#------------------------------------------------------------------------------
17#
18
19if {[lsearch [namespace children] ::tcltest] == -1} {
20    package require tcltest
21    namespace import ::tcltest::*
22}
23
24package require Tclx 8.4
25
26set testArray(foo) bar
27set testArray(snap) frammistan
28set testArray(0) zero
29set testArray(william) dafoe
30
31test for_array_keys-1.1 {for_array_keys command} {
32    for_array_keys key testArray {
33        lappend result $key
34    }
35    lsort $result
36} "0 foo snap william"
37
38test for_array_keys-1.2 {errors in for_array_keys command} {
39    list [catch {
40        for_array_keys key testArray {
41            error fakeResult fakeInfo fakeCode
42        }
43    } msg] $msg [crange $errorInfo 0 7] $errorCode
44} {1 fakeResult fakeInfo fakeCode}
45
46test for_array_keys-1.3 {break in for_array_keys command} {
47    set cnt 0
48    list [catch {
49        for_array_keys key testArray {
50            incr cnt
51            break
52        }
53    } msg] $msg $cnt
54} {0 {} 1}
55
56test for_array_keys-1.4 {break in for_array_keys command} {
57    set cnt 0
58    list [catch {
59        for_array_keys key testArray {
60            incr cnt
61            continue
62            incr cnt 20
63        }
64    } msg] $msg $cnt
65} {0 {} 4}
66
67test for_array_keys-1.5 {return in for_array_keys command} {
68    proc for_array_keys_test {testArrayVar cntVar} {
69        upvar $testArrayVar testArray $cntVar cnt
70        for_array_keys key testArray {
71            incr cnt
72            return abcd
73        }
74    }
75    set cnt 0
76    list [catch {for_array_keys_test testArray cnt} msg] $msg $cnt
77} {0 abcd 1}
78rename for_array_keys_test {}
79
80unset testArray
81unset result
82
83# cleanup
84::tcltest::cleanupTests
85return
86