path: root/tests/array.test

# Commands covered:  array
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 2016 Andy Goth
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] < 0} {
    package require tcltest 2
}
::tcltest::loadTestedCommands
catch {package require -exact Tcltest [info patchlevel]}
set namespaces [namespace children]
set procs [info procs]
set vars [info vars]

# test set   chapter title
# ---------  -----------------------
# array-1.*  subcommand dispatch
# array-2.*  common argument parsing
# array-3.*  array set
# array-4.*  array unset
# array-5.*  array statistics
# array-6.*  array exists|size|names|get
# array-7.*  array anymore|donesearch|nextelement|startsearch

# test set   [array] subcommand  arrayName             mode and filter
# ---------  ------------------  --------------------  ---------------
# array-7.*  anymore             array required        not allowed
# array-7.*  donesearch          array required        not allowed
# array-6.*  exists              anything              optional
# array-6.*  get                 anything              optional
# array-6.*  names               anything              optional
# array-7.*  nextelement         array required        not allowed
# array-3.*  set                 array or nonexistent  not allowed
# array-6.*  size                anything              optional
# array-7.*  startsearch         array required        optional
# array-5.*  statistics          array required        not allowed
# array-4.*  unset               anything              optional
# array-1.*  (unique abbrev)     (see above)           (see above)
# array-1.*  (ambiguous abbrev)  (error)               (error)
# array-1.*  (invalid)           (error)               (error)

# oxfordJoin --
# and --
# or --
# Joins a list by commas, a conjunction, or both, using Oxford comma rules,
# matching Tcl's internal algorithm for displaying lists in error messages.
proc oxfordJoin {conjunction list} {
    if {[llength $list] > 1} {
        lset list end "$conjunction [lindex $list end]"
    }
    if {[llength $list] < 3} {
        join $list " "
    } else {
        join $list ", "
    }
}
interp alias {} and {} oxfordJoin and
interp alias {} or {} oxfordJoin or

# samples --
# Produces a list of sample arguments, given a list of parameters.
# Customizations can be applied via $args.
proc samples {params args} {
    set map [dict merge {
        arrayName   a
        searchId    s-1-a
        ?mode?      -exact
        ?pattern?   hello
        list        {hello world}
    } $args]
    lmap param $params {dict get $map $param}
}

# test --
# Wrapper around [::tcltest::test] with additional features:
#
# - Single-argument block design gives a cleaner visual presentation.
# - All script execution is performed in a new stack frame.
# - Script variables are shared across scripts via a temporary namespace.
# - All definition values (except scripts) are [subst]'ed.
#
# The $def argument is a dict which defines the test.  Its possible keys are:
#
# - name | desc
#   Test name and description.
#
# - {scalar name} | {array name}
#   The name component of the key is the name of a scalar or array variable, and
#   the value is the initial scalar value or array dictionary value.  These
#   variables are shared across the setup, body, and cleanup scripts.
#
# - link
#   Uninitialized variables shared across the setup, body, and cleanup scripts.
#
# - setup | body | cleanup
#   The scripts are modified to include variable initialization, linkage, and
#   finalization and to be executed inside new stack frames.
#
# - constraints | result | output | errorOutput | returnCodes | match
#   See tcltest(n) for the purpose of these keys.
proc test {def} {
    # Perform uplevel substitutions, and process scalar and array arguments.
    set scalars {}
    set arrays {}
    dict for {key val} $def {
        if {$key ni {setup body cleanup}} {
            dict set def $key [set val [uplevel [list subst $val]]]
        }
        if {[llength $key] == 2} {
            if {[lindex $key 0] eq "scalar"} {
                dict set scalars [lindex $key 1] $val
                dict unset def $key
            } elseif {[lindex $key 0] eq "array"} {
                dict set arrays [lindex $key 1] $val
                dict unset def $key
            }
        }
    }

    # Augment scripts with variable initialization, linkage, and finalization.
    dict lappend def link {*}[dict keys $scalars] {*}[dict keys $arrays]
    if {[llength [dict get $def link]]} {
        # Ensure all three scripts exist, even if empty.
        foreach key {setup body cleanup} {
            dict append def $key
        }

        # Build variable initialization, linkage, and finalization snippets.
        set initial [list namespace eval ::TestVars [join [list\
            [list variable {*}$scalars]\
            {*}[lmap {var val} $arrays {list variable $var}]\
            {*}[lmap {var val} $arrays {list array set $var $val}]] \n]]
        set linkage [join [lmap var [dict get $def link]\
            {list variable ::TestVars::$var}] \n]
        set final [list namespace delete ::TestVars]

        # Update scripts.
        dict set def setup $initial\n$linkage\n[dict get $def setup]
        dict set def body $linkage\n[dict get $def body]
        dict set def cleanup $linkage\n[dict get $def cleanup]\n$final
    }
    dict unset def link

    # Convert scripts to zero-argument lambda invocations.
    foreach key {setup body cleanup} {
        if {[dict exists $def $key]} {
            dict set def $key [list apply [list {} [dict get $def $key]]]
        }
    }

    # Assemble the Tcltest command.
    set command [list ::tcltest::test [dict get $def name] [dict get $def desc]]
    dict unset def name
    dict unset def desc
    foreach key {constraints setup body cleanup result output errorOutput
            returnCodes match} {
        if {[dict exists $def $key]} {
            lappend command -$key [dict get $def $key]
            dict unset def $key
        }
    }

    # Complain if there are any invalid test definition keys.
    if {[dict size $def]} {
        error "bad test definition key(s): [and [dict keys $def]]"
    }

    # Run the Tcltest command.
    tailcall {*}$command
}

# Formal parameters for each array subcommand.
set params {
    anymore     {arrayName searchId}
    donesearch  {arrayName searchId}
    exists      {arrayName ?mode? ?pattern?}
    get         {arrayName ?mode? ?pattern?}
    names       {arrayName ?mode? ?pattern?}
    nextelement {arrayName searchId}
    set         {arrayName list}
    size        {arrayName ?mode? ?pattern?}
    startsearch {arrayName ?mode? ?pattern?}
    statistics  {arrayName}
    unset       {arrayName ?mode? ?pattern?}
}

# List of array subcommands.
set commands [lsort [dict keys $params]]

# Ambiguous and unambiguous abbreviations of array subcommands.
foreach cmd $commands {
    for {set i 0} {$i < [string length $cmd] - 1} {incr i} {
        set abbrev [string range $cmd 0 $i]
        if {$abbrev in $commands
         || [llength [lsearch -all $commands $abbrev*]] == 1} {
            dict lappend abbrevs $cmd $abbrev
        } else {
            dict set ambig $abbrev {}
        }
    }
}
set ambig [lsort [dict keys $ambig]]

# List of valid array filter mode options.
set modes [lsort {-exact -glob -regexp}]

######################## array-1.*: subcommand dispatch ########################
test {
    name array-1.1
    desc {no subcommand}
    body {array}
    returnCodes error
    result {wrong # args: should be "array subcommand ?arg ...?"}
}
test {
    name array-1.2
    desc {empty subcommand}
    body {array {}}
    returnCodes error
    result {unknown or ambiguous subcommand "": must be [or $commands]}
}
test {
    name array-1.3
    desc {invalid subcommand}
    body {array gorp}
    returnCodes error
    result {unknown or ambiguous subcommand "gorp": must be [or $commands]}
}
foreach cmd $ambig {
    test {
        name array-1.4.$cmd
        desc {ambiguous subcommand: \[array $cmd\]}
        {scalar cmd} $cmd
        body {array $cmd}
        returnCodes error
        result {unknown or ambiguous subcommand "$cmd": must be [or $commands]}
    }
}
foreach cmd $commands {
    test {
        name array-1.5.$cmd
        desc {formal parameter lists: \[array $cmd\]}
        {scalar cmd} $cmd
        body {array $cmd}
        returnCodes error
        result {wrong # args: should be "array $cmd [dict get $params $cmd]"}
    }
}

###################### array-2.*: common argument parsing ######################
foreach {cmd    code    resultPattern} {
    anymore     error   "\"%VAR%\" %MSG%"
    donesearch  error   "\"%VAR%\" %MSG%"
    exists      ok      0
    get         ok      {}
    names       ok      {}
    nextelement error   "\"%VAR%\" %MSG%"
    set         error   "can't set \"%VAR%%ELEM%\": %MSG%"
    size        ok      0
    startsearch error   "\"%VAR%\" %MSG%"
    statistics  error   "\"%VAR%\" %MSG%"
    unset       ok      {}
} {
    test {
        name array-2.1.$cmd
        desc {too many arguments: \[array $cmd\]}
        {scalar cmd} $cmd
        {scalar args} {[lmap param [dict get $params $cmd] {samples $param}]}
        body {array $cmd {*}$args extra}
        returnCodes error
        result {wrong # args: should be "array $cmd [dict get $params $cmd]"}
    }
    if {"?mode?" in [dict get $params $cmd]} {
        test {
            name array-2.2.$cmd
            desc {ambiguous mode: \[array $cmd\]"}
            {scalar cmd} $cmd
            {array a} {}
            body {array $cmd a {} {}}
            returnCodes error
            result {ambiguous option "": must be [or $modes]}
        }
        test {
            name array-2.3.$cmd
            desc {invalid mode: \[array $cmd\]}
            {scalar cmd} $cmd
            {array a} {}
            body {array $cmd a INVALID {}}
            returnCodes error
            result {bad option "INVALID": must be [or $modes]}
        }
        test {
            name array-2.4.$cmd
            desc {invalid regexp: \[array $cmd\]}
            {scalar cmd} $cmd
            {array a} {e 1}
            body {array $cmd a -regexp *}
            returnCodes error
            result {couldn't compile regular expression pattern:\
                quantifier operand invalid}
        }
    }
    test {
        name array-2.5.$cmd
        desc {array trace error during variable lookup: \[array $cmd\]}
        {scalar cmd} $cmd
        {scalar args} {[lmap param [dict get $params $cmd] {samples $param}]}
        link a
        setup {trace add variable a array {apply {{args} {error $args}}}}
        body {array $cmd {*}$args}
        returnCodes error
        result {can't trace array "a": a {} array}
    }
    if {$cmd eq "set"} {
        set nonArray "variable isn't array"
        set nonNamespace "parent namespace doesn't exist"
    } else {
        set nonArray "isn't an array"
        set nonNamespace "isn't an array"
    }
    foreach {
        desc                                skip    setup
        name        msg             var     elem    extra
    } {
        "nonexistent array"                 set     {}
        array-2.6   nonArray        a       {}      {}

        "element of proc-slot-only array"   set     {}
        array-2.7   nonArray        a       {}      {set a(hello) 123}

        "scalar variable"                   {}      {{scalar a} {}}
        array-2.8   nonArray        a       (hello) {}

        "element of empty array"            {}      {{array a} {}}
        array-2.9   nonArray        a(x)    {}      {}

        "element of nonexistent array"      {}      {}
        array-2.10  nonArray        a(x)    {}      {}

        "element of scalar variable"        {}      {{scalar a} {}}
        array-2.11  nonArray        a(x)    {}      {}

        "existing element of array"         {}      {{scalar a} {x 123}}
        array-2.12  nonArray        a(x)    {}      {}

        "nonexistent element of array"      {}      {{array a} {}}
        array-2.13  nonArray        a(x)    {}      {}

        "bad namespace"                     {}      {}
        array-2.14  nonNamespace    ::X::a  {}      {}
    } {
        if {$cmd ni $skip} {
            set map [list %VAR% $var %MSG% [set $msg] %ELEM% $elem]
            test [string map [list %SETUP% $setup %EXTRA% $extra] {
                name $name.$cmd
                desc {$desc: \[array $cmd\]}
                {scalar cmd} $cmd
                {scalar args} {[samples [dict get $params $cmd] arrayName $var]}
                %SETUP%
                body {set result [array $cmd {*}$args]; %EXTRA%; return $result}
                returnCodes $code
                result {[string map $map $resultPattern]}
            }]
        }
    }
}

############################# array-3.*: array set #############################
test {
    name array-3.1
    desc {empty}
    body {array set a {}; list [array exists a] [array get a]}
    result {1 {}}
}
test {
    name array-3.2
    desc {one array element}
    body {array set a {e 1}; array get a}
    result {e 1}
}
test {
    name array-3.3
    desc {missing value}
    body {array set a e}
    returnCodes error
    result {list must have an even number of elements}
}
test {
    name array-3.4
    desc {duplicate key}
    body {array set a {e 0 e 1}; array get a}
    result {e 1}
}
test {
    name array-3.5
    desc {invalid list}
    body {array set a \{\}x}
    returnCodes error
    result {list element in braces followed by "x" instead of space}
}
test {
    name array-3.6
    desc {invalid list part 2}
    body {array set a \"\"x}
    returnCodes error
    result {list element in quotes followed by "x" instead of space}
}
test {
    name array-3.7
    desc {invalid list part 3}
    body {array set a \{}
    returnCodes error
    result {unmatched open brace in list}
}
test {
    name array-3.8
    desc {invalid list part 4}
    body {array set a \"}
    returnCodes error
    result {unmatched open quote in list}
}
test {
    name array-3.9
    desc {hash order}
    body {array set a {f 2 e 1}; array get a}
    result {e 1 f 2}
}
test {
    name array-3.10
    desc {adding elements}
    body {array set a {f 2}; array set a {e 1}; array get a}
    result {e 1 f 2}
}
test {
    name array-3.11
    desc {adding elements, hash order}
    body {array set a {e 1}; array set a {f 2}; array get a}
    result {e 1 f 2}
}
test {
    name array-3.12
    desc {replacing elements}
    body {array set a {e 1}; array set a {e 2}; array get a}
    result {e 2}
}
test {
    name array-3.13
    desc {adding and replacing elements}
    body {array set a {e 1}; array set a {f 3 e 2}; array get a}
    result {e 2 f 3}
}
test {
    name array-3.14
    desc {former scalar}
    {scalar a} xxx
    body {unset a; array set a {e 1}; array get a}
    result {e 1}
}
test {
    name array-3.15
    desc {weird names}
    body {array set a {{ a  b } 1 ) 2 ( 3 )( 4 () 5 {} 6}; array get a}
    result {{} 6 ( 3 () 5 )( 4 ) 2 { a  b } 1}
}

############################ array-4.*: array unset ############################
test {
    name array-4.1
    desc {unset empty array}
    {array a} {}
    body {array unset a; info exists a}
    result 0
}
test {
    name array-4.2
    desc {unset non-empty array}
    {array a} {e 1}
    body {array unset a; info exists a}
    result 0
}
test {
    name array-4.3
    desc {unset scalar}
    {scalar a} x
    body {array unset a; return $a}
    result x
}
test {
    name array-4.4
    desc {unset all elements of empty array}
    {array a} {}
    body {array unset a *; list [info exists a] [array size a]}
    result {1 0}
}
test {
    name array-4.5
    desc {unset all elements of non-empty array}
    {array a} {e 1}
    body {array unset a *; list [info exists a] [array size a]}
    result {1 0}
}
test {
    name array-4.6
    desc {unset all elements of scalar array}
    {scalar a} x
    body {array unset a *; return $a}
    result x
}
test {
    name array-4.7
    desc {unset single existing element using -exact}
    {array a} {f 2 e 1}
    body {array unset a -exact e; array get a}
    result {f 2}
}
test {
    name array-4.8
    desc {unset single nonexistent element using -exact}
    {array a} {f 2 e 1}
    body {array unset a -exact d; array get a}
    result {e 1 f 2}
}
test {
    name array-4.9
    desc {unset single existing element using default mode}
    {array a} {f 2 e 1}
    body {array unset a e; array get a}
    result {f 2}
}
test {
    name array-4.10
    desc {unset single nonexistent element using default mode}
    {array a} {f 2 e 1}
    body {array unset a d; array get a}
    result {e 1 f 2}
}
test {
    name array-4.11
    desc {unset single existing element using -glob}
    {array a} {f 2 e 1}
    body {array unset a -glob {[e]}; array get a}
    result {f 2}
}
test {
    name array-4.12
    desc {unset single nonexistent element using -glob}
    {array a} {f 2 e 1}
    body {array unset a -glob {[d]}; array get a}
    result {e 1 f 2}
}
test {
    name array-4.13
    desc {unset single existing element using -regexp}
    {array a} {f 2 e 1}
    body {array unset a -regexp {^[e]}; array get a}
    result {f 2}
}
test {
    name array-4.14
    desc {unset single nonexistent element using -regexp}
    {array a} {f 2 e 1}
    body {array unset a -regexp {^[d]}; array get a}
    result {e 1 f 2}
}
test {
    name array-4.15
    desc {confirm unset -exact does not match substrings}
    {array a} {abc 1}
    body {array unset a -exact b; array get a}
    result {abc 1}
}
test {
    name array-4.16
    desc {confirm unset -glob does not match substrings}
    {array a} {abc 1}
    body {array unset a -glob b; array get a}
    result {abc 1}
}
test {
    name array-4.17
    desc {confirm unset -regexp does match substrings}
    {array a} {abc 1}
    body {array unset a -regexp b; array get a}
    result {}
}

######################### array-5.*: array statistics ##########################
# Note: array-5.3 expected results obtained from Tcl version 8.5.7
test {
    name array-5.1
    desc {empty array}
    {array a} {}
    body {array statistics a}
    result
{0 entries in table, 4 buckets
number of buckets with 0 entries: 4
number of buckets with 1 entries: 0
number of buckets with 2 entries: 0
number of buckets with 3 entries: 0
number of buckets with 4 entries: 0
number of buckets with 5 entries: 0
number of buckets with 6 entries: 0
number of buckets with 7 entries: 0
number of buckets with 8 entries: 0
number of buckets with 9 entries: 0
number of buckets with 10 or more entries: 0
average search distance for entry: 0.0}
}
test {
    name array-5.2
    desc {single-element array}
    {array a} {e 1}
    body {array statistics a}
    result
{1 entries in table, 4 buckets
number of buckets with 0 entries: 3
number of buckets with 1 entries: 1
number of buckets with 2 entries: 0
number of buckets with 3 entries: 0
number of buckets with 4 entries: 0
number of buckets with 5 entries: 0
number of buckets with 6 entries: 0
number of buckets with 7 entries: 0
number of buckets with 8 entries: 0
number of buckets with 9 entries: 0
number of buckets with 10 or more entries: 0
average search distance for entry: 1.0}
}
test {
    name array-5.3
    desc {thousand-element array}
    link a
    setup {for {set i 0} {$i < 1000} {incr i} {set a($i) $i}}
    body {array statistics a}
    result
{1000 entries in table, 1024 buckets
number of buckets with 0 entries: 285
number of buckets with 1 entries: 520
number of buckets with 2 entries: 180
number of buckets with 3 entries: 36
number of buckets with 4 entries: 3
number of buckets with 5 entries: 0
number of buckets with 6 entries: 0
number of buckets with 7 entries: 0
number of buckets with 8 entries: 0
number of buckets with 9 entries: 0
number of buckets with 10 or more entries: 0
average search distance for entry: 1.3}
}
test {
    name array-5.4
    desc {collision attack}
    link a
    setup {
        for {set i 16} {$i < 29} {incr i} {
            set a([binary format cc $i [expr {-$i * 9}]]) $i
        }
    }
    body {array statistics a}
    result
{13 entries in table, 16 buckets
number of buckets with 0 entries: 15
number of buckets with 1 entries: 0
number of buckets with 2 entries: 0
number of buckets with 3 entries: 0
number of buckets with 4 entries: 0
number of buckets with 5 entries: 0
number of buckets with 6 entries: 0
number of buckets with 7 entries: 0
number of buckets with 8 entries: 0
number of buckets with 9 entries: 0
number of buckets with 10 or more entries: 1
average search distance for entry: 7.0}
}

################### array-6.*: array exists|size|names|get #####################
foreach {
    desc
    name        dict        args            exists  size    names   get
} {
    "empty array"
    array-6.1   {}          {}              1       0       {}      {}

    "non-empty array"
    array-6.2   {e 1}       {}              1       1       {e}     {e 1}

    "nonexistent element using default mode"
    array-6.3   {e 1}       {[d]}           0       0       {}      {}

    "existing element using default mode"
    array-6.4   {e 1}       {[e]}           1       1       {e}     {e 1}

    "multiple elements using default mode"
    array-6.5   {e 1 f 2}   {[ef]}          1       2       {e f}   {e 1 f 2}

    "nonexistent element using -glob"
    array-6.6   {e 1}       {-glob [d]}     0       0       {}      {}

    "existing element using -glob"
    array-6.7   {e 1}       {-glob [e]}     1       1       {e}     {e 1}

    "multiple elements using -glob"
    array-6.8   {e 1 f 2}   {-glob [ef]}    1       2       {e f}   {e 1 f 2}

    "nonexistent element using -exact"
    array-6.9   {e 1}       {-exact d}      0       0       {}      {}

    "existing element using -exact"
    array-6.10  {e 1}       {-exact e}      1       1       {e}     {e 1}

    "nonexistent element using -regexp"
    array-6.11  {e 1}       {-regexp ^[d]}  0       0       {}      {}

    "existing element using -regexp"
    array-6.12  {e 1}       {-regexp ^[e]}  1       1       {e}     {e 1}

    "multiple elements using -regexp"
    array-6.13  {e 1 f 2}   {-regexp ^[ef]} 1       2       {e f}   {e 1 f 2}
} {
    foreach cmd {exists size names get} {
        test [string map [list %RESULT% [set $cmd]] {
            name $name.$cmd
            desc {$desc: \[array $cmd\]}
            {scalar cmd} $cmd
            {scalar args} $args
            {array a} $dict
            body {array $cmd a {*}$args}
            result {%RESULT%}
        }]
    }
}
foreach {
    cmd     small   large
} {
    exists  1       1
    size    1       2
    names   {e}     {e f}
    get     {e 1}   {e 1 f 2}
} {
    test {
        name array-6.14.$cmd
        desc {increasing array size: \[array $cmd\]}
        {scalar cmd} $cmd
        {array a} {e 1}
        body {list [array $cmd a][set a(f) 2; list] [array $cmd a]}
        result {[list $small $large]}
    }
    test {
        name array-6.15.$cmd
        desc {decreasing array size: \[array $cmd\]}
        {scalar cmd} $cmd
        {array a} {e 1 f 2}
        body {list [array $cmd a][unset a(f)] [array $cmd a]}
        result {[list $large $small]}
    }
}

######### array-7.*: array anymore|donesearch|nextelement|startsearch ##########
foreach cmd {anymore donesearch nextelement} {
    test {
        name array-7.1.$cmd
        desc {nonexistent search token}
        {scalar cmd} $cmd
        {array a} {}
        body {array $cmd a s-1-a}
        returnCodes error
        result {couldn't find search "s-1-a"}
    }
}
foreach {
    desc
    name        dict        args            result
} {
    "no filter, empty array"
    array-7.2   {}          {}              {}

    "no filter, single element"
    array-7.3   {e 1}       {}              {e}

    "no filter, two elements"
    array-7.4   {f 2 e 1}   {}              {e f}

    "default filter, matches nothing"
    array-7.5   {f 2 e 1}   {[g]}           {}

    "default filter, matches one item"
    array-7.6   {f 2 e 1}   {[f]}           {f}

    "default filter, matches two items"
    array-7.7   {f 2 e 1}   {[ef]}          {e f}

    "-glob filter, matches nothing"
    array-7.8   {f 2 e 1}   {-glob [g]}     {}

    "-glob filter, matches one item"
    array-7.9   {f 2 e 1}   {-glob [f]}     {f}

    "-glob filter, matches two items"
    array-7.10  {f 2 e 1}   {-glob [ef]}    {e f}

    "-exact filter, matches nothing"
    array-7.11  {f 2 e 1}   {-exact g}      {}

    "-exact filter, matches one item"
    array-7.12  {f 2 e 1}   {-exact f}      {f}

    "-regexp filter, matches nothing"
    array-7.13  {f 2 e 1}   {-regexp ^[g]}  {}

    "-regexp filter, matches one item"
    array-7.14  {f 2 e 1}   {-regexp ^[f]}  {f}

    "-regexp filter, matches two items"
    array-7.15  {f 2 e 1}   {-regexp ^[ef]} {e f}
} {
    test {
        name $name
        desc $desc
        {scalar args} $args
        {array a} $dict
        body {
            set result {}
            set s [array startsearch a {*}$args]
            while {[array anymore a $s]} {
                lappend result [array nextelement a $s]
            }
            array donesearch a $s
            return $result
        }
        result $result
    }
}
test {
    name array-7.16
    desc {unset visited element during search, bug 46a2410650, s/a var-13.2}
    {array a} {aa 11 bb 22 cc 33 dd 44 ee 55 ff 66}
    body {
        set s [array startsearch a]
        unset a([array nextelement a $s])
        array anymore a $s
    }
    returnCodes error
    result {couldn't find search "s-1-a"}
}
test {
    name array-7.17
    desc {unset future element during search, bug 46a2410650, s/a var-13.3}
    {array a} {aa 11 bb 22 cc 33 dd 44 ee 55 ff 66}
    body {
        set result {}
        set s [array startsearch a]
        unset a(ee)
        array anymore a $s
    }
    returnCodes error
    result {couldn't find search "s-1-a"}
}

# Cleanup.
foreach namespace [namespace children] {
    if {$namespace ni $namespaces} {
        namespace delete $namespace
    }
}
foreach proc [info procs] {
    if {$proc ni $procs} {
        rename $proc {}
    }
}
foreach var [info vars] {
    if {$var ne "vars" && $var ni $vars} {
        unset $var
    }
}
unset -nocomplain var vars
::tcltest::cleanupTests
return

# vim: set sts=4 sw=4 tw=80 et ft=tcl:
# Local Variables:
# mode: tcl
# End: