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
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
|
# -*- tcl -*-
# common.test: Tests for the common code of the name service
#
# Sourcing this file into Tcl runs the tests and generates output for
# errors. No output means no errors were found.
# -------------------------------------------------------------------------
set testutilsscript [file join \
[file dirname [file dirname [file join [pwd] [info script]]]] \
devtools testutilities.tcl]
source $testutilsscript
package require tcltest
testsNeedTcl 8.6 ; # See coroutine (required by cron)
testsNeedTcltest 1.0
testsNeed udp
set ::WHOAMI Main
support {
use dicttool/dicttool.tcl dicttool
use snit/snit2.tcl snit ;# Required by comm
use comm/comm.tcl comm
use dns/ip.tcl ip
use nettool/nettool.tcl nettool
use coroutine/coroutine.tcl coroutine ;# Required by cron
use cron/cron.tcl cron
use uuid/uuid.tcl uuid
use interp/interp.tcl interp
use log/logger.tcl logger
use md5/md5x.tcl md5
}
testing {
useLocal udpcluster.tcl udpcluster
}
###
# Create a server in a seperate interp
###
interp create server
interp eval server [list set testutilsscript $testutilsscript]
interp eval server {
source $testutilsscript
set ::WHOAMI Server
package require tcltest
testsNeedTcl 8.6
testsNeedTcltest 1.0
testsNeed udp
support {
use dicttool/dicttool.tcl dicttool
use snit/snit2.tcl snit ;# Required by comm
use comm/comm.tcl comm
use dns/ip.tcl ip
use nettool/nettool.tcl nettool
use coroutine/coroutine.tcl coroutine ;# Required by cron
use cron/cron.tcl cron
use uuid/uuid.tcl uuid
use interp/interp.tcl interp
use log/logger.tcl logger
use md5/md5x.tcl md5
}
testing {
use udpcluster/udpcluster.tcl udpcluster
}
set ::cluster::local_pid SERVER
#set ::cluster::config(debug) 1
::cluster::publish nns@[::cluster::macid] {}
update
}
set ::cluster::local_pid MAIN
set macid [::cluster::macid]
set myport [::nettool::allocate_port 10000]
::cluster::ping nns@$macid
set data [::cluster::search *]
test cluster-comm-1.0 {Publish service - NNS} {
dict exists $data nns@[::cluster::macid]
} {1}
test cluster-comm-1.1 {Check that non-existant service does not exist} {
dict exists $data foo@bar
} {0}
###
# Create a phony service
###
set now [clock seconds]
::cluster::publish foo@bar [list clocktime $now]
# The windows event loop needs a breather
::cluster::ping nns@$macid
set data [::cluster::search *]
test cluster-comm-2.0 {Publish service - NNS} {
dict exists $data nns@[::cluster::macid]
} {1}
test cluster-comm-2.1 {Check that new service does exists} {
dict exists $data foo@bar
} {1}
###
# Modify a service
###
::cluster::configure foo@bar {color pink}
::cluster::ping nns@$macid
set data [::cluster::search foo@bar]
test cluster-comm-2.3 {Modify a service} {
dict get $data foo@bar color
} {pink}
::cluster::configure foo@bar {color blue}
::cluster::ping nns@$macid
set data [::cluster::search foo@bar]
test cluster-comm-2.4 {Modify a service} {
dict get $data foo@bar color
} {blue}
###
# Create another client in a seperate interp
###
interp create otherclient
interp eval otherclient [list set testutilsscript $testutilsscript]
interp eval otherclient {
source $testutilsscript
set ::WHOAMI Other
package require tcltest
testsNeedTcl 8.6
testsNeedTcltest 1.0
testsNeed udp
support {
use dicttool/dicttool.tcl dicttool
use snit/snit2.tcl snit ;# Required by comm
use comm/comm.tcl comm
use dns/ip.tcl ip
use nettool/nettool.tcl nettool
use coroutine/coroutine.tcl coroutine ;# Required by cron
use cron/cron.tcl cron
use uuid/uuid.tcl uuid
use interp/interp.tcl interp
use log/logger.tcl logger
use md5/md5x.tcl md5
}
testing {
use udpcluster/udpcluster.tcl udpcluster
}
###
# Cheat and let this server know the server is local
###
set macid [::cluster::macid]
set myport [::nettool::allocate_port 10000]
#set ::cluster::config(debug) 1
set url other@$macid
::comm::comm new $url -port $myport -local 0 -listen 1
::cluster::publish $url [list port $myport protocol comm class comm]
}
#set ::cluster::config(debug) 1
::cluster::ping nns@$macid
set data [::cluster::search *]
test cluster-comm-3.0 {Publish service - NNS} {
dict exists $data nns@[::cluster::macid]
} {1}
test cluster-comm-3.1 {Check that new service does exists} {
dict exists $data foo@bar
} {1}
test cluster-comm-3.3 {Check that other service does exists} {
dict exists $data other@[::cluster::macid]
} {1}
test cluster-comm-3.3 {Check that other service does exists} {
set chan [::cluster::resolve other@[::cluster::macid]]
::comm::comm send $chan {set foo b}
} {b}
###
# Remove the phony service
###
::cluster::unpublish foo@bar {}
::cluster::ping nns@$macid
set data [::cluster::search *]
test cluster-comm-4.0 {Publish service - NNS} {
dict exists $data nns@[::cluster::macid]
} {1}
# Shorten the normal 2 minute timeout to 5 seconds
set ::cluster::config(ping_timeout) 5
test cluster-comm-4.1 {Check that service is closed} {
dict exists $data foo@bar
} {0}
###
# Have a non-existant service fail
###
test cluster-comm-5.0 {Service lookup failture} {
catch {cluster::resolve foo@bar} pat
} {1}
#puts $pat
###
# Test port allocation
###
set port [interp eval otherclient {
::cluster::get_free_port 58080
}]
# Check that the port is allocated in this thread as well
test cluster-port-alloc-1.0 {Port allocation} {
::cluster::directory port_busy $port
} 1
set otherport [interp eval otherclient {
::cluster::get_free_port 58080
}]
puts [list GET FREE PORT $port $otherport [::cluster::get_free_port 58080]]
test cluster-port-alloc-2.0 {Port allocation} {
expr {$otherport != $port}
} 1
puts "DONE"
testsuiteCleanup
return
|
