1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
#
# Privacy options for components
# ----------------------------------------------------------------------
# AUTHOR: Michael J. McLennan
# Bell Labs Innovations for Lucent Technologies
# mmclennan@lucent.com
# http://www.tcltk.com/itcl
#
# RCS: $Id: privacy.test,v 1.3 2004/09/22 09:37:09 davygrvy Exp $
# ----------------------------------------------------------------------
# Copyright (c) 1993-1998 Lucent Technologies, Inc.
# ======================================================================
# See the file "license.terms" for information on usage and
# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
package require tcltest
namespace import -force ::tcltest::*
::tcltest::loadTestedCommands
# ----------------------------------------------------------------------
# Define a base class with public variables and a simple mega-widget
# ----------------------------------------------------------------------
test privacy-1.1 {define simple mega-widget class} {
itcl::class TestPrivacy {
inherit itk::Widget
constructor {args} {
eval itk_initialize $args
}
method do {args} {
return [eval $args]
}
}
set testobj [TestPrivacy .#auto]
pack $testobj
} {}
test privacy-1.2 {"itk_component add" requires certain arguments} {
list [catch {$testobj do itk_component add foo} msg] $msg \
[catch {$testobj do itk_component add foo bar baz qux} msg] $msg
} {1 {wrong # args: should be "itk_component add ?-protected? ?-private? ?--? name createCmds ?optionCmds?"} 1 {wrong # args: should be "add ?-protected? ?-private? ?--? name createCmds ?optionCmds?}}
test privacy-1.3 {"itk_component add" rejects invalid options} {
list [catch {
$testobj do itk_component add -foo bar baz qux
} msg] $msg \
[catch {
$testobj do itk_component add -- -foo {label $itk_interior.l}
} msg] $msg
} {1 {bad option "-foo": should be -private, -protected or --} 0 -foo}
test privacy-1.4 {"itk_component add" recognizes privacy options} {
list [catch {
$testobj do itk_component add -protected x {label $itk_interior.x}
} msg] $msg \
[catch {
$testobj do itk_component add -private y {label $itk_interior.y}
} msg] $msg
} {0 x 0 y}
test privacy-1.5 {protected/private components are hidden} {
list [lsort [$testobj component]] \
[lsort [$testobj do component]]
} {{-foo hull} {-foo hull x y}}
test privacy-1.6 {define a derived class and add protected/private comps} {
itcl::class TestMorePrivacy {
inherit TestPrivacy
constructor {args} {
eval itk_initialize $args
}
method do {args} {
return [eval $args]
}
}
set testobj2 [TestMorePrivacy .#auto]
$testobj2 TestPrivacy::do itk_component add -private x {
label $itk_interior.x
}
$testobj2 TestPrivacy::do itk_component add -protected y {
label $itk_interior.y
}
$testobj2 TestPrivacy::do itk_component add z {
label $itk_interior.z
}
} {z}
test privacy-1.7 {components are visible depending on namespace context} {
list [lsort [$testobj2 component]] \
[lsort [$testobj2 do component]] \
[lsort [$testobj2 TestPrivacy::do component]]
} {{hull z} {hull y z} {hull x y z}}
# ----------------------------------------------------------------------
# Clean up
# ----------------------------------------------------------------------
itcl::delete class TestPrivacy TestMorePrivacy
::tcltest::cleanupTests
exit
|
