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

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [tests/] [compile.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
# This file contains tests for the file tclCompile.c.
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) 1997 by Sun Microsystems, Inc.
8
#
9
# See the file "license.terms" for information on usage and redistribution
10
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
11
#
12
# RCS: @(#) $Id: compile.test,v 1.1.1.1 2002-01-16 10:25:35 markom Exp $
13
 
14
if {[string compare test [info procs test]] == 1} then {source defs}
15
 
16
# The following tests are very incomplete, although the rest of the
17
# test suite covers this file fairly well.
18
 
19
catch {rename p ""}
20
catch {namespace delete test_ns_compile}
21
catch {unset x}
22
catch {unset y}
23
catch {unset a}
24
 
25
test compile-1.1 {TclCompileString: look up cmds in proc ns, not current ns} {
26
    catch {namespace delete test_ns_compile}
27
    catch {unset x}
28
    set x 123
29
    namespace eval test_ns_compile {
30
        proc set {args} {
31
            global x
32
            lappend x test_ns_compile::set
33
        }
34
        proc p {} {
35
            set 0
36
        }
37
    }
38
    list [test_ns_compile::p] [set x]
39
} {{123 test_ns_compile::set} {123 test_ns_compile::set}}
40
test compile-1.2 {TclCompileString, error result is reset if TclGetLong determines word isn't an integer} {
41
    proc p {x} {info commands 3m}
42
    list [catch {p} msg] $msg
43
} {1 {no value given for parameter "x" to "p"}}
44
 
45
test compile-2.1 {TclCompileDollarVar: global scalar name with ::s} {
46
    catch {unset x}
47
    set x 123
48
    list $::x [expr {[lsearch -exact [info globals] x] != 0}]
49
} {123 1}
50
test compile-2.2 {TclCompileDollarVar: global scalar name with ::s} {
51
    catch {unset y}
52
    proc p {} {
53
        set ::y 789
54
        return $::y
55
    }
56
    list [p] $::y [expr {[lsearch -exact [info globals] y] != 0}]
57
} {789 789 1}
58
test compile-2.3 {TclCompileDollarVar: global array name with ::s} {
59
    catch {unset a}
60
    set ::a(1) 2
61
    list $::a(1) [set ::a($::a(1)) 3] $::a(2) [expr {[lsearch -exact [info globals] a] != 0}]
62
} {2 3 3 1}
63
test compile-2.4 {TclCompileDollarVar: global scalar name with ::s} {
64
    catch {unset a}
65
    proc p {} {
66
        set ::a(1) 1
67
        return $::a($::a(1))
68
    }
69
    list [p] $::a(1) [expr {[lsearch -exact [info globals] a] != 0}]
70
} {1 1 1}
71
 
72
test compile-3.2 {TclCompileCatchCmd: non-local variables} {
73
    set ::foo 1
74
    proc catch-test {} {
75
        catch {set x 3} ::foo
76
    }
77
    catch-test
78
    set ::foo
79
} 3
80
 
81
 
82
test compile-1.16 {TclCompileForCmd: command substituted test expression} {
83
    set i 0
84
    set j 0
85
    # Should be "forever"
86
    for {} [expr $i < 3] {} {
87
        set j [incr i]
88
        if {$j > 3} break
89
    }
90
    set j
91
} {4}
92
 
93
test compile-3.1 {TclCompileForeachCmd: exception stack} {
94
    proc foreach-exception-test {} {
95
        foreach array(index) [list 1 2 3] break
96
        foreach array(index) [list 1 2 3] break
97
        foreach scalar [list 1 2 3] break
98
    }
99
    list [catch foreach-exception-test result] $result
100
} {0 {}}
101
test compile-3.2 {TclCompileForeachCmd: non-local variables} {
102
    set ::foo 1
103
    proc foreach-test {} {
104
        foreach ::foo {1 2 3} {}
105
    }
106
    foreach-test
107
    set ::foo
108
} 3
109
 
110
test compile-4.1 {TclCompileSetCmd: global scalar names with ::s} {
111
    catch {unset x}
112
    catch {unset y}
113
    set x 123
114
    proc p {} {
115
        set ::y 789
116
        return $::y
117
    }
118
    list $::x [expr {[lsearch -exact [info globals] x] != 0}] \
119
         [p] $::y [expr {[lsearch -exact [info globals] y] != 0}]
120
} {123 1 789 789 1}
121
test compile-4.2 {TclCompileSetCmd: global array names with ::s} {
122
    catch {unset a}
123
    set ::a(1) 2
124
    proc p {} {
125
        set ::a(1) 1
126
        return $::a($::a(1))
127
    }
128
    list $::a(1) [p] [set ::a($::a(1)) 3] $::a(1) [expr {[lsearch -exact [info globals] a] != 0}]
129
} {2 1 3 3 1}
130
test compile-4.3 {TclCompileSetCmd: namespace var names with ::s} {
131
    catch {namespace delete test_ns_compile}
132
    catch {unset x}
133
    namespace eval test_ns_compile {
134
        variable v hello
135
        variable arr
136
        set ::x $::test_ns_compile::v
137
        set ::test_ns_compile::arr(1) 123
138
    }
139
    list $::x $::test_ns_compile::arr(1)
140
} {hello 123}
141
 
142
test compile-1.15 {TclCompileWhileCmd: command substituted test expression} {
143
    set i 0
144
    set j 0
145
    # Should be "forever"
146
    while [expr $i < 3] {
147
        set j [incr i]
148
        if {$j > 3} break
149
    }
150
    set j
151
} {4}
152
 
153
test compile-5.1 {CollectArgInfo: binary data} {
154
    list [catch "string length \000foo" msg] $msg
155
} {0 4}
156
test compile-5.2 {CollectArgInfo: binary data} {
157
    list [catch "string length foo\000" msg] $msg
158
} {0 4}
159
test compile-5.3 {CollectArgInfo: handle "]" at end of command properly} {
160
    set x ]
161
} {]}
162
 
163
test compile-6.1 {UpdateStringOfByteCode: called for duplicate of compiled empty object} {
164
    proc p {} {
165
        set x {}
166
        eval $x
167
        append x { }
168
        eval $x
169
    }
170
    p
171
} {}
172
 
173
catch {rename p ""}
174
catch {namespace delete test_ns_compile}
175
catch {unset x}
176
catch {unset y}
177
catch {unset a}
178
 
179
return

powered by: WebSVN 2.1.0

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