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.