2
# Tests for method/variable protection and access
3
# ----------------------------------------------------------------------
4
# AUTHOR: Michael J. McLennan
5
# Bell Labs Innovations for Lucent Technologies
7
# http://www.tcltk.com/itcl
8
# ----------------------------------------------------------------------
9
# Copyright (c) 1993-1998 Lucent Technologies, Inc.
10
# ======================================================================
11
# See the file "license.terms" for information on usage and
12
# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14
package require tcltest 2.1
15
namespace import ::tcltest::test
16
::tcltest::loadTestedCommands
19
# ----------------------------------------------------------------------
20
# Class members are protected by access restrictions
21
# ----------------------------------------------------------------------
22
test protect-1.1 {define a class with various protection levels} {
25
variable pubv "public var"
26
common pubc "public com"
27
method pubm {} {return "public method"}
28
method ovpubm {} {return "overloaded public method"}
29
proc pubp {} {return "public proc"}
32
variable prov "protected var"
33
common proc "protected com"
34
method prom {} {return "protected method"}
35
method ovprom {} {return "overloaded protected method"}
36
proc prop {} {return "protected proc"}
39
variable priv "private var"
40
common pric "private com"
41
method prim {} {return "private method"}
42
method ovprim {} {return "overloaded private method"}
43
proc prip {} {return "private proc"}
45
method do {args} {eval $args}
49
test protect-1.2 {create an object to execute tests} {
53
test protect-1.3a {public methods can be accessed from outside} {
54
list [catch {test_pr0 pubm} msg] $msg
57
test protect-1.3b {public methods can be accessed from inside} {
58
list [catch {test_pr0 do pubm} msg] $msg
61
test protect-1.4a {protected methods are blocked from outside} {
62
list [catch {test_pr0 prom} msg] $msg
63
} {1 {bad option "prom": should be one of...
65
test_pr0 configure ?-option? ?value -option value...?
66
test_pr0 do ?arg arg ...?
67
test_pr0 isa className
71
test protect-1.4b {protected methods can be accessed from inside} {
72
list [catch {test_pr0 do prom} msg] $msg
73
} {0 {protected method}}
75
test protect-1.5a {private methods are blocked from outside} {
76
list [catch {test_pr0 prim} msg] $msg
77
} {1 {bad option "prim": should be one of...
79
test_pr0 configure ?-option? ?value -option value...?
80
test_pr0 do ?arg arg ...?
81
test_pr0 isa className
85
test protect-1.5b {private methods can be accessed from inside} {
86
list [catch {test_pr0 do prim} msg] $msg
87
} {0 {private method}}
89
test protect-1.6a {public procs can be accessed from outside} {
90
list [catch {test_pr::pubp} msg] $msg
93
test protect-1.6b {public procs can be accessed from inside} {
94
list [catch {test_pr0 do pubp} msg] $msg
97
test protect-1.7a {protected procs are blocked from outside} {
98
list [catch {test_pr::prop} msg] $msg
99
} {1 {can't access "::test_pr::prop": protected function}}
101
test protect-1.7b {protected procs can be accessed from inside} {
102
list [catch {test_pr0 do prop} msg] $msg
103
} {0 {protected proc}}
105
test protect-1.8a {private procs are blocked from outside} {
106
list [catch {test_pr::prip} msg] $msg
107
} {1 {can't access "::test_pr::prip": private function}}
109
test protect-1.8b {private procs can be accessed from inside} {
110
list [catch {test_pr0 do prip} msg] $msg
113
test protect-1.9a {public commons can be accessed from outside} {
114
list [catch {set test_pr::pubc} msg] $msg
117
test protect-1.9b {public commons can be accessed from inside} {
118
list [catch {test_pr0 do set pubc} msg] $msg
121
test protect-1.10 {protected commons can be accessed from inside} {
122
list [catch {test_pr0 do set proc} msg] $msg
123
} {0 {protected com}}
125
test protect-1.11 {private commons can be accessed from inside} {
126
list [catch {test_pr0 do set pric} msg] $msg
129
test protect-1.12a {object-specific variables require an access command} {
130
list [catch {set test_pr::pubv} msg] $msg
131
} {1 {can't read "test_pr::pubv": no such variable}}
133
test protect-1.12b {public variables can be accessed from inside} {
134
list [catch {test_pr0 do set pubv} msg] $msg
137
test protect-1.13a {object-specific variables require an access command} {
138
list [catch {set test_pr::prov} msg] $msg
139
} {1 {can't read "test_pr::prov": no such variable}}
141
test protect-1.13b {protected variables can be accessed from inside} {
142
list [catch {test_pr0 do set prov} msg] $msg
143
} {0 {protected var}}
145
test protect-1.14a {object-specific variables require an access command} {
146
list [catch {set test_pr::priv} msg] $msg
147
} {1 {can't read "test_pr::priv": no such variable}}
149
test protect-1.14b {private variables can be accessed from inside} {
150
list [catch {test_pr0 do set priv} msg] $msg
153
# ----------------------------------------------------------------------
154
# Access restrictions work properly with inheritance
155
# ----------------------------------------------------------------------
156
test protect-2.1 {define a derived class} {
157
itcl::class test_pr_derived {
159
method do {args} {eval $args}
161
public method ovpubm {} {return "specific public method"}
162
protected method ovprom {} {return "specific protected method"}
163
private method ovprim {} {return "specific private method"}
165
public method dpubm {} {return "pub (only in derived)"}
166
protected method dprom {} {return "pro (only in derived)"}
167
private method dprim {} {return "pri (only in derived)"}
171
test protect-2.2 {create an object to execute tests} {
172
test_pr_derived #auto
175
test protect-2.3 {public methods can be accessed from inside} {
176
list [catch {test_pr_derived0 do pubm} msg] $msg
177
} {0 {public method}}
179
test protect-2.4 {protected methods can be accessed from inside} {
180
list [catch {test_pr_derived0 do prom} msg] $msg
181
} {0 {protected method}}
183
test protect-2.5 {private methods are blocked} {
184
list [catch {test_pr_derived0 do prim} msg] $msg
185
} {1 {invalid command name "prim"}}
187
test protect-2.6 {public procs can be accessed from inside} {
188
list [catch {test_pr_derived0 do pubp} msg] $msg
191
test protect-2.7 {protected procs can be accessed from inside} {
192
list [catch {test_pr_derived0 do prop} msg] $msg
193
} {0 {protected proc}}
195
test protect-2.8 {private procs are blocked} {
196
list [catch {test_pr_derived0 do prip} msg] $msg
197
} {1 {invalid command name "prip"}}
199
test protect-2.9 {public commons can be accessed from inside} {
200
list [catch {test_pr_derived0 do set pubc} msg] $msg
203
test protect-2.10 {protected commons can be accessed from inside} {
204
list [catch {test_pr_derived0 do set proc} msg] $msg
205
} {0 {protected com}}
207
test protect-2.11 {private commons are blocked} {
208
list [catch {test_pr_derived0 do set pric} msg] $msg
209
} {1 {can't read "pric": no such variable}}
211
test protect-2.12 {public variables can be accessed from inside} {
212
list [catch {test_pr_derived0 do set pubv} msg] $msg
215
test protect-2.13 {protected variables can be accessed from inside} {
216
list [catch {test_pr_derived0 do set prov} msg] $msg
217
} {0 {protected var}}
219
test protect-2.14 {private variables are blocked} {
220
list [catch {test_pr_derived0 do set priv} msg] $msg
221
} {1 {can't read "priv": no such variable}}
223
test protect-2.15 {can access overloaded public method} {
224
set cmd {namespace eval test_pr_derived {test_pr_derived0 ovpubm}}
225
list [catch $cmd msg] $msg
226
} {0 {specific public method}}
228
test protect-2.16 {can access overloaded public method} {
229
set cmd {namespace eval test_pr_derived {test_pr_derived0 ovprom}}
230
list [catch $cmd msg] $msg
231
} {0 {specific protected method}}
233
test protect-2.17 {can access overloaded private method} {
234
set cmd {namespace eval test_pr_derived {test_pr_derived0 ovprim}}
235
list [catch $cmd msg] $msg
236
} {0 {specific private method}}
238
test protect-2.18 {can access overloaded public method from base class} {
239
set cmd {namespace eval test_pr {test_pr_derived0 ovpubm}}
240
list [catch $cmd msg] $msg
241
} {0 {specific public method}}
243
test protect-2.19 {can access overloaded protected method from base class} {
244
set cmd {namespace eval test_pr {test_pr_derived0 ovprom}}
245
list [catch $cmd msg] $msg
246
} {0 {specific protected method}}
248
test protect-2.20 {*cannot* access overloaded private method from base class} {
249
set cmd {namespace eval test_pr {test_pr_derived0 ovprim}}
250
list [catch $cmd msg] $msg
251
} {1 {bad option "ovprim": should be one of...
252
test_pr_derived0 cget -option
253
test_pr_derived0 configure ?-option? ?value -option value...?
254
test_pr_derived0 do ?arg arg ...?
255
test_pr_derived0 dpubm
256
test_pr_derived0 isa className
257
test_pr_derived0 ovprom
258
test_pr_derived0 ovpubm
259
test_pr_derived0 prim
260
test_pr_derived0 prom
261
test_pr_derived0 pubm}}
263
test protect-2.21 {can access non-overloaded public method from base class} {
264
set cmd {namespace eval test_pr {test_pr_derived0 dpubm}}
265
list [catch $cmd msg] $msg
266
} {0 {pub (only in derived)}}
268
test protect-2.22 {*cannot* access non-overloaded protected method from base class} {
269
set cmd {namespace eval test_pr {test_pr_derived0 dprom}}
270
list [catch $cmd msg] $msg
271
} {1 {bad option "dprom": should be one of...
272
test_pr_derived0 cget -option
273
test_pr_derived0 configure ?-option? ?value -option value...?
274
test_pr_derived0 do ?arg arg ...?
275
test_pr_derived0 dpubm
276
test_pr_derived0 isa className
277
test_pr_derived0 ovprom
278
test_pr_derived0 ovpubm
279
test_pr_derived0 prim
280
test_pr_derived0 prom
281
test_pr_derived0 pubm}}
283
test protect-2.23 {*cannot* access non-overloaded private method from base class} {
284
set cmd {namespace eval test_pr {test_pr_derived0 dprim}}
285
list [catch $cmd msg] $msg
286
} {1 {bad option "dprim": should be one of...
287
test_pr_derived0 cget -option
288
test_pr_derived0 configure ?-option? ?value -option value...?
289
test_pr_derived0 do ?arg arg ...?
290
test_pr_derived0 dpubm
291
test_pr_derived0 isa className
292
test_pr_derived0 ovprom
293
test_pr_derived0 ovpubm
294
test_pr_derived0 prim
295
test_pr_derived0 prom
296
test_pr_derived0 pubm}}
298
eval namespace delete [itcl::find classes test_pr*]
300
# ----------------------------------------------------------------------
301
# Access restrictions don't mess up "info"
302
# ----------------------------------------------------------------------
303
test protect-3.1 {define a base class with private variables} {
304
itcl::class test_info_base {
305
private variable pribv "pribv-value"
306
private common pribc "pribc-value"
307
protected variable probv "probv-value"
308
protected common probc "probc-value"
309
public variable pubbv "pubbv-value"
310
public common pubbc "pubbc-value"
312
itcl::class test_info_derived {
313
inherit test_info_base
314
private variable pridv "pridv-value"
315
private common pridc "pridc-value"
319
test protect-3.2 {create an object to execute tests} {
320
test_info_derived #auto
321
} {test_info_derived0}
323
test protect-3.3 {all variables are reported} {
324
list [catch {test_info_derived0 info variable} msg] [lsort $msg]
325
} {0 {::test_info_base::pribc ::test_info_base::pribv ::test_info_base::probc ::test_info_base::probv ::test_info_base::pubbc ::test_info_base::pubbv ::test_info_derived::pridc ::test_info_derived::pridv ::test_info_derived::this}}
327
test protect-3.4 {private base class variables can be accessed} {
328
list [catch {test_info_derived0 info variable pribv} msg] $msg
329
} {0 {private variable ::test_info_base::pribv pribv-value pribv-value}}
331
test protect-3.5 {private base class commons can be accessed} {
332
list [catch {test_info_derived0 info variable pribc} msg] $msg
333
} {0 {private common ::test_info_base::pribc pribc-value pribc-value}}
335
test protect-3.6 {protected base class variables can be accessed} {
336
list [catch {test_info_derived0 info variable probv} msg] $msg
337
} {0 {protected variable ::test_info_base::probv probv-value probv-value}}
339
test protect-3.7 {protected base class commons can be accessed} {
340
list [catch {test_info_derived0 info variable probc} msg] $msg
341
} {0 {protected common ::test_info_base::probc probc-value probc-value}}
343
test protect-3.8 {public base class variables can be accessed} {
344
list [catch {test_info_derived0 info variable pubbv} msg] $msg
345
} {0 {public variable ::test_info_base::pubbv pubbv-value {} pubbv-value}}
347
test protect-3.9 {public base class commons can be accessed} {
348
list [catch {test_info_derived0 info variable pubbc} msg] $msg
349
} {0 {public common ::test_info_base::pubbc pubbc-value pubbc-value}}
351
test protect-3.10 {private derived class variables can be accessed} {
352
list [catch {test_info_derived0 info variable pridv} msg] $msg
353
} {0 {private variable ::test_info_derived::pridv pridv-value pridv-value}}
355
test protect-3.11 {private derived class commons can be accessed} {
356
list [catch {test_info_derived0 info variable pridc} msg] $msg
357
} {0 {private common ::test_info_derived::pridc pridc-value pridc-value}}
359
test protect-3.12 {private base class variables can't be accessed from class} {
361
namespace eval test_info_derived {info variable pribv}
363
} {1 {cannot access object-specific info without an object context}}
365
test protect-3.13 {private base class commons can be accessed from class} {
367
namespace eval test_info_derived {info variable pribc}
369
} {0 {private common ::test_info_base::pribc pribc-value pribc-value}}
371
eval namespace delete [itcl::find classes test_info*]
373
::tcltest::cleanupTests
added
removed
tests/protection.test
