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