Subversion Repositories or1k

# Commands covered:  list

#

# 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) 1991-1993 The Regents of the University of California.

# Copyright (c) 1994 Sun Microsystems, Inc.

#

# See the file "license.terms" for information on usage and redistribution

# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#

# RCS: @(#) $Id: list.test,v 1.1.1.1 2002-01-16 10:25:36 markom Exp $

if {[string compare test [info procs test]] == 1} then {source defs}

# First, a bunch of individual tests

test list-1.1 {basic tests} {list a b c} {a b c}

test list-1.2 {basic tests} {list {a b} c} {{a b} c}

test list-1.3 {basic tests} {list \{a b c} {\{a b c}

test list-1.4 {basic tests} "list a{}} b{} c}" "a\\{\\}\\} b{} c\\}"

test list-1.5 {basic tests} {list a\[ b\] } "{a\[} b\\]"

test list-1.6 {basic tests} {list c\  d\t } "{c } {d\t}"

test list-1.7 {basic tests} {list e\n f\$ } "{e\n} {f\$}"

test list-1.8 {basic tests} {list g\; h\\} {{g;} h\\}

test list-1.9 {basic tests} "list a\\\[} b\\\]} " "a\\\[\\\} b\\\]\\\}"

test list-1.10 {basic tests} "list c\\\} d\\t} " "c\\} d\\t\\}"

test list-1.11 {basic tests} "list e\\n} f\\$} " "e\\n\\} f\\$\\}"

test list-1.12 {basic tests} "list g\\;} h\\\\} " "g\\;\\} {h\\}}"

test list-1.13 {basic tests} {list a {{}} b} {a {{}} b}

test list-1.14 {basic tests} {list a b xy\\} "a b xy\\\\"

test list-1.15 {basic tests} "list a b\} e\\" "a b\\} e\\\\"

test list-1.16 {basic tests} "list a b\}\\\$ e\\\$\\" "a b\\}\\\$ e\\\$\\\\"

test list-1.17 {basic tests} {list a\f \{\f} "{a\f} \\\{\\f"

test list-1.18 {basic tests} {list a\r \{\r} "{a\r} \\\{\\r"

test list-1.19 {basic tests} {list a\v \{\v} "{a\v} \\\{\\v"

test list-1.20 {basic tests} {list \"\}\{} "\\\"\\}\\{"

test list-1.21 {basic tests} {list a b c\\\nd} "a b c\\\\\\nd"

test list-1.22 {basic tests} {list "{ab}\\"} \\{ab\\}\\\\

test list-1.23 {basic tests} {list \{} "\\{"

test list-1.24 {basic tests} {list} {}

# For the next round of tests create a list and then pick it apart

# with "index" to make sure that we get back exactly what went in.

test list-2.1 {placeholder} {

} {}

set num 1

proc lcheck {a b c} {

    global num d

    set d [list $a $b $c]

;   test list-2.$num {what goes in must come out} {lindex $d 0} $a

    set num [expr $num+1]

;   test list-2.$num {what goes in must come out} {lindex $d 1} $b

    set num [expr $num+1]

;   test list-2.$num {what goes in must come out} {lindex $d 2} $c

    set num [expr $num+1]

}

lcheck a b c

lcheck "a b" c\td e\nf

lcheck {{a b}} {} {  }

lcheck \$ \$ab ab\$

lcheck \; \;ab ab\;

lcheck \[ \[ab ab\[

lcheck \\ \\ab ab\\

lcheck {"} {"ab} {ab"}

lcheck {a b} { ab} {ab }

lcheck a{ a{b \{ab

lcheck a} a}b }ab

lcheck a\\} {a \}b} {a \{c}

lcheck xyz \\ 1\\\n2

lcheck "{ab}\\" "{ab}xy" abc

concat {}

# Check that tclListObj.c's SetListFromAny handles possible overlarge

# string rep lengths in the source object.

proc slowsort list {

    set result {}

    set last [expr [llength $list] - 1]

    while {$last > 0} {

        set minIndex [expr [llength $list] - 1]

        set min [lindex $list $last]

        set i [expr $minIndex-1]

        while {$i >= 0} {

            if {[string compare [lindex $list $i] $min] < 0} {

                set minIndex $i

                set min [lindex $list $i]

            }

            set i [expr $i-1]

        }

        set result [concat $result [list $min]]

        if {$minIndex == 0} {

            set list [lrange $list 1 end]

        } else {

            set list [concat [lrange $list 0 [expr $minIndex-1]] \

                          [lrange $list [expr $minIndex+1] end]]

        }

        set last [expr $last-1]

    }

    return [concat $result $list]

}

test list-3.1 {SetListFromAny and lrange/concat results} {

    slowsort {fred julie alex carol bill annie}

} {alex annie bill carol fred julie}