Tcl Library Source Code

Artifact 64d58e8604f7e263f4886a82ab66506da83b7d70:

• File modules/tie/tie_array.test — part of check-in [ea701e91fe] at 2006-10-09 21:41:39 on branch trunk — Switched all remaining test suites over to the new cleanup command to hook them into the environment handling. (user: andreas_kupries size: 8363)

# Tests for the tie module.                              -*- tcl -*- 
#
# Copyright (c) 2004 Andreas Kupries <[email protected]>
# All rights reserved.
#
# RCS: @(#) $Id: tie_array.test,v 1.7 2006/10/09 21:41:42 andreas_kupries Exp $

# -------------------------------------------------------------------------

source [file join \
	[file dirname [file dirname [file join [pwd] [info script]]]] \
	devtools testutilities.tcl]

testsNeedTcl     8.4
testsNeedTcltest 1.0

support {
    use      snit/snit.tcl snit
    useLocal tie.tcl       tie
}
testing {
    useLocal tie_array.tcl tie::std::array
}

# -------------------------------------------------------------------------

proc group {dict} {
    set res {}
    foreach {k v} $dict {lappend res [list $k $v]}
    return $res
}

proc ignore {dict args} {
    array set tmp $dict
    foreach k $args {unset tmp($k)}
    array get tmp
}

# -------------------------------------------------------------------------
# Creation of array data sources
# Errors: Undefined variable, scalar, local variable

test tie-array-1.0 {array creation, wrong#args} {
    catch {tie::std::array} msg
    set msg
} {Error in constructor: wrong # args: should be "::tie::std::array::Snit_constructor type selfns win self rvar"}

test tie-array-1.1 {array creation, wrong#args} {
    catch {tie::std::array x} msg
    set msg
} {Error in constructor: wrong # args: should be "::tie::std::array::Snit_constructor type selfns win self rvar"}

test tie-array-1.2 {array creation, wrong#args} {
    catch {tie::std::array x y z} msg
    set msg
} {Error in constructor: wrong # args: should be "::tie::std::array::Snit_constructor type selfns win self rvar"}


test tie-array-1.3 {array creation, fixed name, undefined array} {
    catch {tie::std::array x y} msg
    set msg
} {Error in constructor: Undefined source array variable "y"}

test tie-array-1.4 {array creation, fixed name, proc local array} {
    proc foo {} {
	global msg
	catch {tie::std::array x y} msg
    }
    foo
    set msg
} {Error in constructor: Illegal use of proc local array variable "y"}

test tie-array-1.5 {array creation, fixed name, scalar variable} {
    unset -nocomplain av ; set av SCALAR
    catch {tie::std::array x av} msg
    set msg
} {Error in constructor: Undefined source array variable "av"}

test tie-array-1.6 {array creation, fixed name, array} {
    unset -nocomplain av ; array set av {}
    set msg [tie::std::array x av]
    x destroy
    set msg
} {::x}

test tie-array-1.7 {array creation, %AUTO%} {
    unset -nocomplain av ; array set av {}
    set msg [tie::std::array %AUTO% av]
    $msg destroy
    set msg
} {::array9}

# -------------------------------------------------------------------------
## Methods

test tie-array-2.0 {array get, wrong#args} {
    unset -nocomplain av ; array set av {b 2 a 1}
    tie::std::array x av
    catch {x get a} msg
    x destroy
    set msg
} {wrong # args: should be "::tie::std::array::Snit_methodget type selfns win self"}

test tie-array-2.1 {array get} {
    unset -nocomplain av ; array set av {b 2 a 1}
    tie::std::array x av
    set res [dictsort [x get]]
    x destroy
    set res
} {a 1 b 2}


test tie-array-3.0 {array set, wrong#args} {
    unset -nocomplain av ; array set av {}
    tie::std::array x av
    set     res {}
    catch {x set} msg
    x destroy
    set msg
} {wrong # args: should be "::tie::std::array::Snit_methodset type selfns win self dict"}

test tie-array-3.1 {array set, wrong#args} {
    unset -nocomplain av ; array set av {}
    tie::std::array x av
    set     res {}
    catch {x set a b} msg
    x destroy
    set msg
} {wrong # args: should be "::tie::std::array::Snit_methodset type selfns win self dict"}

test tie-array-3.2 {array set} {
    unset -nocomplain av ; array set av {}
    tie::std::array x av
    set     res {}
    lappend res [x set {c 3 b 2 a 1}]
    lappend res [dictsort [array get av]]
    x destroy
    set res
} {{} {a 1 b 2 c 3}}


test tie-array-4.0 {array names, wrong#args} {
    unset -nocomplain av ; array set av {b 2 a 1}
    tie::std::array x av
    catch {x names a} msg
    x destroy
    set msg
} {wrong # args: should be "::tie::std::array::Snit_methodnames type selfns win self"}

test tie-array-4.1 {array names} {
    unset -nocomplain av ; array set av {b 2 a 1}
    tie::std::array x av
    set res [lsort [x names]]
    x destroy
    set res
} {a b}


test tie-array-5.0 {array size, wrong#args} {
    unset -nocomplain av ; array set av {b 2 a 1}
    tie::std::array x av
    catch {x size a} msg
    x destroy
    set msg
} {wrong # args: should be "::tie::std::array::Snit_methodsize type selfns win self"}

test tie-array-5.1 {array size} {
    unset -nocomplain av ; array set av {b 2 a 1}
    tie::std::array x av
    set res [x size]
    x destroy
    set res
} 2


test tie-array-6.0 {array unset, wrong#args} {
    unset -nocomplain av ; array set av {foo bar fox snarf a 3}
    tie::std::array x av
    set     res {}
    catch {x unset a b} msg
    x destroy
    set msg
} {wrong # args: should be "::tie::std::array::Snit_methodunset type selfns win self ?pattern?"}

test tie-array-6.1 {array unset, default pattern} {
    unset -nocomplain av ; array set av {foo bar fox snarf a 3}
    tie::std::array x av
    set     res {}
    lappend res [x unset]
    lappend res [dictsort [array get av]]
    x destroy
    set res
} {{} {}}

test tie-array-6.2 {array unset, by pattern} {
    unset -nocomplain av ; array set av {foo bar fox snarf a 3}
    tie::std::array x av
    set     res {}
    lappend res [x unset f*]
    lappend res [dictsort [array get av]]
    x destroy
    set res
} {{} {a 3}}


test tie-array-7.0 {array getv, wrong#args} {
    unset -nocomplain av ; array set av {}
    tie::std::array x av
    set     res {}
    catch {x getv} msg
    x destroy
    set msg
} {wrong # args: should be "::tie::std::array::Snit_methodgetv type selfns win self index"}

test tie-array-7.1 {array getv, wrong#args} {
    unset -nocomplain av ; array set av {}
    tie::std::array x av
    set     res {}
    catch {x getv a b} msg
    x destroy
    set msg
} {wrong # args: should be "::tie::std::array::Snit_methodgetv type selfns win self index"}

test tie-array-7.2 {array getv} {
    unset -nocomplain av ; array set av {a 3 b 4}
    tie::std::array x av
    set     res {}
    lappend res [x getv a]
    x destroy
    set res
} 3


test tie-array-8.0 {array setv, wrong#args} {
    unset -nocomplain av ; array set av {}
    tie::std::array x av
    set     res {}
    catch {x setv} msg
    x destroy
    set msg
} {wrong # args: should be "::tie::std::array::Snit_methodsetv type selfns win self index value"}

test tie-array-8.1 {array setv, wrong#args} {
    unset -nocomplain av ; array set av {}
    tie::std::array x av
    set     res {}
    catch {x setv a} msg
    x destroy
    set msg
} {wrong # args: should be "::tie::std::array::Snit_methodsetv type selfns win self index value"}

test tie-array-8.2 {array setv, wrong#args} {
    unset -nocomplain av ; array set av {}
    tie::std::array x av
    set     res {}
    catch {x setv a b c} msg
    x destroy
    set msg
} {wrong # args: should be "::tie::std::array::Snit_methodsetv type selfns win self index value"}

test tie-array-8.3 {array setv} {
    unset -nocomplain av ; array set av {}
    tie::std::array x av
    set     res {}
    lappend res [x setv fox snarf]
    lappend res [dictsort [array get av]]
    x destroy
    set res
} {{} {fox snarf}}


test tie-array-9.0 {array unsetv, wrong#args} {
    unset -nocomplain av ; array set av {}
    tie::std::array x av
    set     res {}
    catch {x unsetv} msg
    x destroy
    set msg
} {wrong # args: should be "::tie::std::array::Snit_methodunsetv type selfns win self index"}

test tie-array-9.1 {array unsetv, wrong#args} {
    unset -nocomplain av ; array set av {}
    tie::std::array x av
    set     res {}
    catch {x unsetv a b} msg
    x destroy
    set msg
} {wrong # args: should be "::tie::std::array::Snit_methodunsetv type selfns win self index"}

test tie-array-9.2 {array unsetv} {
    unset -nocomplain av ; array set av {a 3 b 4}
    tie::std::array x av
    set     res {}
    lappend res [x unsetv a]
    lappend res [dictsort [array get av]]
    x destroy
    set res
} {{} {b 4}}

testsuiteCleanup
return