OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [tests/] [append.test] - Blame information for rev 1774

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom 
# Commands covered:  append lappend
2 
#
3 
# This file contains a collection of tests for one or more of the Tcl
4 
# built-in commands.  Sourcing this file into Tcl runs the tests and
5 
# generates output for errors.  No output means no errors were found.
6 
#
7 
# Copyright (c) 1991-1993 The Regents of the University of California.
8 
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
9 
#
10 
# See the file "license.terms" for information on usage and redistribution
11 
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12 
#
13 
# RCS: @(#) $Id: append.test,v 1.1.1.1 2002-01-16 10:25:35 markom Exp $
14 
 
15 
if {[string compare test [info procs test]] == 1} then {source defs}
16 
 
17 
catch {unset x}
18 
test append-1.1 {append command} {
19 
    catch {unset x}
20 
    list [append x 1 2 abc "long string"] $x
21 
} {{12abclong string} {12abclong string}}
22 
test append-1.2 {append command} {
23 
    set x ""
24 
    list [append x first] [append x second] [append x third] $x
25 
} {first firstsecond firstsecondthird firstsecondthird}
26 
test append-1.3 {append command} {
27 
    set x "abcd"
28 
    append x
29 
} abcd
30 
 
31 
test append-2.1 {long appends} {
32 
    set x ""
33 
    for {set i 0} {$i < 1000} {set i [expr $i+1]} {
34 
        append x "foobar "
35 
    }
36 
    set y "foobar"
37 
    set y "$y $y $y $y $y $y $y $y $y $y"
38 
    set y "$y $y $y $y $y $y $y $y $y $y"
39 
    set y "$y $y $y $y $y $y $y $y $y $y "
40 
    expr {$x == $y}
41 
} 1
42 
 
43 
test append-3.1 {append errors} {
44 
    list [catch {append} msg] $msg
45 
} {1 {wrong # args: should be "append varName ?value value ...?"}}
46 
test append-3.2 {append errors} {
47 
    set x ""
48 
    list [catch {append x(0) 44} msg] $msg
49 
} {1 {can't set "x(0)": variable isn't array}}
50 
test append-3.3 {append errors} {
51 
    catch {unset x}
52 
    list [catch {append x} msg] $msg
53 
} {1 {can't read "x": no such variable}}
54 
 
55 
test append-4.1 {lappend command} {
56 
    catch {unset x}
57 
    list [lappend x 1 2 abc "long string"] $x
58 
} {{1 2 abc {long string}} {1 2 abc {long string}}}
59 
test append-4.2 {lappend command} {
60 
    set x ""
61 
    list [lappend x first] [lappend x second] [lappend x third] $x
62 
} {first {first second} {first second third} {first second third}}
63 
test append-4.3 {lappend command} {
64 
    proc foo {} {
65 
        global x
66 
        set x old
67 
        unset x
68 
        lappend x new
69 
    }
70 
    set result [foo]
71 
    rename foo {}
72 
    set result
73 
} {new}
74 
test append-4.4 {lappend command} {
75 
    set x {}
76 
    lappend x \{\  abc
77 
} {\{\  abc}
78 
test append-4.5 {lappend command} {
79 
    set x {}
80 
    lappend x \{ abc
81 
} {\{ abc}
82 
test append-4.6 {lappend command} {
83 
    set x {1 2 3}
84 
    lappend x
85 
} {1 2 3}
86 
test append-4.7 {lappend command} {
87 
    set x "a\{"
88 
    lappend x abc
89 
} "a\\\{ abc"
90 
test append-4.8 {lappend command} {
91 
    set x "\\\{"
92 
    lappend x abc
93 
} "\\{ abc"
94 
test append-4.9 {lappend command} {
95 
    set x " \{"
96 
    list [catch {lappend x abc} msg] $msg
97 
} {1 {unmatched open brace in list}}
98 
test append-4.10 {lappend command} {
99 
    set x "     \{"
100 
    list [catch {lappend x abc} msg] $msg
101 
} {1 {unmatched open brace in list}}
102 
test append-4.11 {lappend command} {
103 
    set x "\{\{\{"
104 
    list [catch {lappend x abc} msg] $msg
105 
} {1 {unmatched open brace in list}}
106 
test append-4.12 {lappend command} {
107 
    set x "x \{\{\{"
108 
    list [catch {lappend x abc} msg] $msg
109 
} {1 {unmatched open brace in list}}
110 
test append-4.13 {lappend command} {
111 
    set x "x\{\{\{"
112 
    lappend x abc
113 
} "x\\\{\\\{\\\{ abc"
114 
test append-4.14 {lappend command} {
115 
    set x " "
116 
    lappend x abc
117 
} "abc"
118 
test append-4.15 {lappend command} {
119 
    set x "\\ "
120 
    lappend x abc
121 
} "{ } abc"
122 
test append-4.16 {lappend command} {
123 
    set x "x "
124 
    lappend x abc
125 
} "x abc"
126 
test append-4.17 {lappend command} {
127 
    catch {unset x}
128 
    lappend x
129 
} {}
130 
 
131 
proc check {var size} {
132 
    set l [llength $var]
133 
    if {$l != $size} {
134 
        return "length mismatch: should have been $size, was $l"
135 
    }
136 
    for {set i 0} {$i < $size} {set i [expr $i+1]} {
137 
        set j [lindex $var $i]
138 
        if {$j != "item $i"} {
139 
            return "element $i should have been \"item $i\", was \"$j\""
140 
        }
141 
    }
142 
    return ok
143 
}
144 
test append-5.1 {long lappends} {
145 
    set x ""
146 
    for {set i 0} {$i < 300} {set i [expr $i+1]} {
147 
        lappend x "item $i"
148 
    }
149 
    check $x 300
150 
} ok
151 
 
152 
test append-6.1 {lappend errors} {
153 
    list [catch {lappend} msg] $msg
154 
} {1 {wrong # args: should be "lappend varName ?value value ...?"}}
155 
test append-6.2 {lappend errors} {
156 
    set x ""
157 
    list [catch {lappend x(0) 44} msg] $msg
158 
} {1 {can't set "x(0)": variable isn't array}}
159 
 
160 
test append-7.1 {lappend-created var and error in trace on that var} {
161 
    catch {rename foo ""}
162 
    catch {unset x}
163 
    trace variable x w foo
164 
    proc foo {} {global x; unset x}
165 
    catch {lappend x 1}
166 
    proc foo {args} {global x; unset x}
167 
    info exists x
168 
    set x
169 
    lappend x 1
170 
    list [info exists x] [catch {set x} msg] $msg
171 
} {0 1 {can't read "x": no such variable}}
172 
 
173 
catch {unset x}
174 
catch {rename foo ""}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.