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

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [itcl/] [itcl/] [tests/] [delete.test] - Blame information for rev 1779

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

Line No. Rev Author Line
1 578 markom 
#
2 
# Tests for deleting classes and objects
3 
# ----------------------------------------------------------------------
4 
#   AUTHOR:  Michael J. McLennan
5 
#            Bell Labs Innovations for Lucent Technologies
6 
#            mmclennan@lucent.com
7 
#            http://www.tcltk.com/itcl
8 
#
9 
#      RCS:  $Id: delete.test,v 1.1.1.1 2002-01-16 10:24:47 markom Exp $
10 
# ----------------------------------------------------------------------
11 
#            Copyright (c) 1993-1998  Lucent Technologies, Inc.
12 
# ======================================================================
13 
# See the file "license.terms" for information on usage and
14 
# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15 
 
16 
if {[string compare test [info procs test]] == 1} then {source defs}
17 
 
18 
# ----------------------------------------------------------------------
19 
#  Deleting classes and objects
20 
# ----------------------------------------------------------------------
21 
test delete-1.1 {define a simple classes with inheritance} {
22 
    itcl::class test_delete_base {
23 
        variable num 0
24 
        method show {} {
25 
            return $num
26 
        }
27 
    }
28 
} ""
29 
 
30 
test delete-1.2 {create some base class objects} {
31 
    for {set i 0} {$i < 5} {incr i} {
32 
        test_delete_base #auto
33 
    }
34 
    lsort [find objects -class test_delete_base]
35 
} {test_delete_base0 test_delete_base1 test_delete_base2 test_delete_base3 test_delete_base4}
36 
 
37 
test delete-1.3 {delete the base class--class and all objects go away} {
38 
    list [delete class test_delete_base] \
39 
         [find classes test_delete_base] \
40 
         [namespace children :: test_delete_base] \
41 
         [namespace which -command test_delete_base] \
42 
         [find objects test_delete_base*]
43 
} {{} {} {} {} {}}
44 
 
45 
# ----------------------------------------------------------------------
46 
#  Deleting classes and objects with inheritance
47 
# ----------------------------------------------------------------------
48 
test delete-2.1 {define a simple classes with inheritance} {
49 
    variable ::test_delete_watch ""
50 
    itcl::class test_delete_base {
51 
        variable num 0
52 
        method show {} {
53 
            return $num
54 
        }
55 
        destructor {
56 
            global ::test_delete_watch
57 
            lappend test_delete_watch $this
58 
        }
59 
    }
60 
    itcl::class test_delete {
61 
        inherit test_delete_base
62 
        method show {} {
63 
            return ">$num<"
64 
        }
65 
    }
66 
} ""
67 
 
68 
test delete-2.2 {create some base and derived class objects} {
69 
    for {set i 0} {$i < 3} {incr i} {
70 
        test_delete_base #auto
71 
    }
72 
    for {set i 0} {$i < 3} {incr i} {
73 
        test_delete #auto
74 
    }
75 
    lsort [find objects -isa test_delete_base]
76 
} {test_delete0 test_delete1 test_delete2 test_delete_base0 test_delete_base1 test_delete_base2}
77 
 
78 
test delete-2.3 {delete the base class--class and all objects go away} {
79 
    list [delete class test_delete_base] \
80 
         [find classes test_delete*] \
81 
         [namespace children :: test_delete*] \
82 
         [namespace which -command test_delete_base] \
83 
         [namespace which -command test_delete] \
84 
         [find objects test_delete*]
85 
} {{} {} {} {} {} {}}
86 
 
87 
test delete-2.4 {object destructors get invoked properly} {
88 
    lsort $test_delete_watch
89 
} {::test_delete0 ::test_delete1 ::test_delete2 ::test_delete_base0 ::test_delete_base1 ::test_delete_base2}
90 
 
91 
# ----------------------------------------------------------------------
92 
#  Deleting class namespaces
93 
# ----------------------------------------------------------------------
94 
test delete-3.1 {redefine classes with inheritance} {
95 
    variable ::test_delete_watch ""
96 
    itcl::class test_delete_base {
97 
        variable num 0
98 
        method show {} {
99 
            return $num
100 
        }
101 
        destructor {
102 
            global test_delete_watch
103 
            lappend test_delete_watch $this
104 
        }
105 
    }
106 
    itcl::class test_delete {
107 
        inherit test_delete_base
108 
        method show {} {
109 
            return ">$num<"
110 
        }
111 
    }
112 
} ""
113 
 
114 
test delete-3.2 {create some base and derived class objects} {
115 
    for {set i 0} {$i < 3} {incr i} {
116 
        test_delete_base #auto
117 
    }
118 
    for {set i 0} {$i < 3} {incr i} {
119 
        test_delete #auto
120 
    }
121 
    lsort [find objects -isa test_delete_base]
122 
} {test_delete0 test_delete1 test_delete2 test_delete_base0 test_delete_base1 test_delete_base2}
123 
 
124 
test delete-3.3 {deleting a class namespace is like deleting a class} {
125 
    list [namespace delete test_delete_base] \
126 
         [find classes test_delete*] \
127 
         [namespace children :: test_delete*] \
128 
         [namespace which -command test_delete_base] \
129 
         [namespace which -command test_delete] \
130 
         [find objects test_delete*]
131 
} {{} {} {} {} {} {}}
132 
 
133 
test delete-3.4 {object destructors get invoked, even during catastrophe} {
134 
    lsort $test_delete_watch
135 
} {::test_delete0 ::test_delete1 ::test_delete2 ::test_delete_base0 ::test_delete_base1 ::test_delete_base2}
136 
 
137 
# ----------------------------------------------------------------------
138 
#  Self-destructing objects
139 
# ----------------------------------------------------------------------
140 
test basic-4.1 {define a class where objects destroy themselves} {
141 
    itcl::class test_delete {
142 
        public variable x ""
143 
        public variable deletecommand ""
144 
        constructor {args} {
145 
            eval configure $args
146 
        }
147 
        destructor {
148 
            eval $deletecommand
149 
        }
150 
        method killme {code} {
151 
            delete object $this
152 
            eval $code
153 
        }
154 
    }
155 
} {}
156 
 
157 
test basic-4.2 {an object can delete itself} {
158 
    set obj [test_delete #auto -x "data stays"]
159 
    list [$obj killme {return $x}] [find objects -isa test_delete]
160 
} {{data stays} {}}
161 
 
162 
test basic-4.3 {the "this" variable becomes null after delete} {
163 
    set obj [test_delete #auto]
164 
    list [$obj killme {return $this}] [find objects -isa test_delete]
165 
} {{} {}}
166 
 
167 
test basic-4.4 {an object being destructed can't be deleted} {
168 
    set obj [test_delete #auto -deletecommand {delete object $this}]
169 
    list [catch {delete object $obj} msg] $msg
170 
} {1 {can't delete an object while it is being destructed}}
171 
 
172 
namespace delete test_delete
173 
 
174 
# ----------------------------------------------------------------------
175 
#  Delete objects using path names and scoped values
176 
# ----------------------------------------------------------------------
177 
test basic-5.1 {define a simple class} {
178 
    itcl::class test_delete_name {
179 
        private variable x 0
180 
        method test {x} {
181 
            return $x
182 
        }
183 
    }
184 
} {}
185 
 
186 
test basic-5.2 {delete using a qualified name} {
187 
    namespace eval test_delete2 {test_delete_name #auto}
188 
    set cmd {delete object test_delete2::test_delete_name0}
189 
    list [catch $cmd msg] $msg [find objects -isa test_delete_name]
190 
} {0 {} {}}
191 
 
192 
test basic-5.3 {delete using a scoped value} {
193 
    set obj [namespace eval test_delete2 {code [test_delete_name #auto]}]
194 
    set cmd [list delete object $obj]
195 
    list [catch $cmd msg] $msg [find objects -isa test_delete_name]
196 
} {0 {} {}}
197 
 
198 
test basic-5.4 {scoped command names are decoded properly} {
199 
    list [catch {delete object {namespace inscope ::xyzzy xxx}} msg] $msg \
200 
         [catch {delete object {namespace inscope :: xxx yyy}} msg] $msg \
201 
         [catch {delete object {namespace inscope :: xyzzy}} msg] $msg
202 
} {1 {unknown namespace "::xyzzy"} 1 {malformed command "namespace inscope :: xxx yyy": should be "namespace inscope namesp command"} 1 {object "namespace inscope :: xyzzy" not found}}
203 
 
204 
namespace delete test_delete_name test_delete2

powered by: WebSVN 2.1.0

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