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
|
# -*- 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.5
testsNeedTcltest 1.0
set ::WHOAMI Main
support {
use snit/snit2.tcl snit
use comm/comm.tcl comm
use dns/ip.tcl ip
use nettool/nettool.tcl nettool
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 nns_cluster.tcl nameserv::cluster
}
###
# 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.5
testsNeedTcltest 1.0
support {
use snit/snit2.tcl snit
use comm/comm.tcl comm
use dns/ip.tcl ip
use nettool/nettool.tcl nettool
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 nns/nns_cluster.tcl nameserv::cluster
}
set ::cluster::local_pid SERVER
::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
testsNeedTcltest 1.0
support {
use snit/snit2.tcl snit
use comm/comm.tcl comm
use dns/ip.tcl ip
use nettool/nettool.tcl nettool
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 nns/nns_cluster.tcl nameserv::cluster
}
###
# Cheat and let this server know the server is local
###
set macid [::cluster::macid]
set myport [::nettool::allocate_port 10000]
set url other@$macid
::comm::comm new $url -port $myport -local 0 -listen 1
::cluster::publish $url [list port $myport protocol comm class comm]
}
::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}
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
testsuiteCleanup
return
|
