blob: ea9671a7954b3199c9963e26520a5f3e83a8282a (
plain)
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
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
|
# ooutil.test - Copyright (c) 2014-2015 Andreas Kupries
# -------------------------------------------------------------------------
source [file join \
[file dirname [file dirname [file join [pwd] [info script]]]] \
devtools testutilities.tcl]
testsNeedTcl 8.5
testsNeedTcltest 2
testsNeed TclOO 1
testing {
useLocal oometa.tcl oo::meta
useLocal oooption.tcl oo::option
}
# -------------------------------------------------------------------------
# Test properties
oo::class create foo {
property color blue
constructor args {
my _staticInit
my configure {*}$args
}
}
oo::class create bar {
superclass ::foo
property shape oval
option color {
label Color
default green
}
}
test oo-class-meta-001 {Test accessing properties} {
foo meta get const color:
} blue
test oo-class-meta-002 {Test accessing properties} {
bar meta get const color:
} blue
test oo-class-meta-003 {Test accessing properties} {
bar meta get const shape:
} oval
bar create cheers color pink
# Pulling the meta data from const will return
# the value specified in the class
test oo-object-meta-001 {Test accessing properties} {
cheers meta get const color:
} blue
# Accessing the data via cget pulls from the local
# definition
test oo-object-meta-001a {Test accessing properties} {
cheers meta cget color
} pink
# With or without the trailing :
test oo-object-meta-001b {Test accessing properties} {
cheers meta cget color:
} pink
# And using the local cget
test oo-object-meta-001c {Test accessing properties} {
cheers cget color
} pink
test oo-object-meta-002 {Test accessing properties} {
cheers meta get const shape:
} oval
test oo-object-meta-003 {Test accessing properties} {
cheers cget color
} pink
bar create moes
test oo-object-meta-004 {Test accessing properties} {
moes meta get const color:
} blue
test oo-object-meta-004a {Test accessing properties} {
moes cget color
} green
test oo-object-meta-004a {Test accessing properties} {
moes cget color:
} green
test oo-object-meta-005 {Test accessing properties} {
moes meta get const shape:
} oval
test oo-object-meta-006 {Test accessing properties} {
moes cget color
} green
test oo-object-meta-007 {Test the CGET retrieves a property if an option doesn't exist} {
moes cget shape
} oval
###
# Test altering a property
###
oo::define ::foo property woozle whoop
test oo-modclass-meta-001 {Test accessing properties of an altered class} {
foo meta get const woozle:
} whoop
test oo-modclass-meta-002 {Test accessing properties of the descendent of an altered class} {
bar meta get const woozle:
} whoop
test oo-modobject-meta-001 {Test the accessing of properties of an instance of an altered class} {
moes meta get const woozle:
} whoop
test obj-meta-for-001 {Test object meta for} {
set result {}
moes meta for {key value} option {
lappend result $key $value
}
set result
} {color {label: Color default: green}}
test obj-meta-with-001 {Test object meta with} {
set result {}
moes meta with option {}
set color
} {label: Color default: green}
test obj-meta-for-001 {Test class meta for} {
set result {}
bar meta for {key value} option {
lappend result $key $value
}
set result
} {color {label: Color default: green}}
test obj-meta-with-001 {Test class meta with} {
set result {}
bar meta with option {}
set color
} {label: Color default: green}
# -------------------------------------------------------------------------
# Test of recursive dicts
oo::class create baz {
superclass ::bar
meta set option color default: purple
}
test obj-meta-recursive-1 {Test that meta set works with recursive dicts} {
set result {}
baz meta get option color default:
} {purple}
test obj-meta-recursive-2 {Test that meta set works with recursive dicts} {
set result {}
baz meta get option color label:
} {Color}
testsuiteCleanup
# Local variables:
# mode: tcl
# indent-tabs-mode: nil
# End:
|
