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
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
|
# -*- tcl -*-
# Graph tests - walk
# Copyright (c) 2006-2017 Andreas Kupries <andreas_kupries@users.sourceforge.net>
# All rights reserved.
# Syntax: graph walk NODE ?-dir forward|backward? ?-order pre|post|both? ?-type bfs|dfs? -command cmd
# -------------------------------------------------------------------------
# Wrong # args: Missing, Too many
test graph-${impl}-${setimpl}-walk-1.0 {walk, wrong#args, missing} {} {
SETUP
catch {mygraph walk} msg
mygraph destroy
set msg
} [tmWrong walk {node ?-dir forward|backward? ?-order pre|post|both? ?-type bfs|dfs? -command cmd} 0 {node args}]
test graph-${impl}-${setimpl}-walk-1.1 {walk, wrong#args, missing} {} {
SETUP
catch {mygraph walk %0} msg
mygraph destroy
set msg
} "wrong # args: should be \"$MY walk node ?-dir forward|backward? ?-order pre|post|both? ?-type bfs|dfs? -command cmd\""
test graph-${impl}-${setimpl}-walk-1.2 {walk, wrong#args, missing} {} {
SETUP
catch {mygraph walk %0 -dir} msg
mygraph destroy
set msg
} "wrong # args: should be \"$MY walk node ?-dir forward|backward? ?-order pre|post|both? ?-type bfs|dfs? -command cmd\""
test graph-${impl}-${setimpl}-walk-1.3 {walk, wrong#args, missing} {} {
SETUP
catch {mygraph walk %0 -order} msg
mygraph destroy
set msg
} "wrong # args: should be \"$MY walk node ?-dir forward|backward? ?-order pre|post|both? ?-type bfs|dfs? -command cmd\""
test graph-${impl}-${setimpl}-walk-1.4 {walk, wrong#args, missing} {} {
SETUP
catch {mygraph walk %0 -type} msg
mygraph destroy
set msg
} "wrong # args: should be \"$MY walk node ?-dir forward|backward? ?-order pre|post|both? ?-type bfs|dfs? -command cmd\""
test graph-${impl}-${setimpl}-walk-1.5 {walk, wrong#args, missing} {} {
SETUP
catch {mygraph walk %0 -command} msg
mygraph destroy
set msg
} "wrong # args: should be \"$MY walk node ?-dir forward|backward? ?-order pre|post|both? ?-type bfs|dfs? -command cmd\""
# -------------------------------------------------------------------------
# Logical arguments checks and failures
test graph-${impl}-${setimpl}-walk-2.0 {walk, missing node} {
SETUP
catch {mygraph walk node0 -command {}} msg
mygraph destroy
set msg
} [MissingNode $MY node0]
test graph-${impl}-${setimpl}-walk-2.1 {walk, unknown option} {
SETUPwalk
catch {mygraph walk i -foo x -command {}} msg
mygraph destroy
set msg
} "unknown option \"-foo\": should be \"$MY walk node ?-dir forward|backward? ?-order pre|post|both? ?-type bfs|dfs? -command cmd\""
test graph-${impl}-${setimpl}-walk-2.2 {walk, empty command} {
SETUPwalk
catch {mygraph walk i -command {}} msg
mygraph destroy
set msg
} "no command specified: should be \"$MY walk node ?-dir forward|backward? ?-order pre|post|both? ?-type bfs|dfs? -command cmd\""
test graph-${impl}-${setimpl}-walk-2.3 {walk, bad search type} {
SETUPwalk
catch {mygraph walk i -command foo -type foo} msg
mygraph destroy
set msg
} {bad search type "foo": must be bfs or dfs}
test graph-${impl}-${setimpl}-walk-2.4 {walk, bad search direction} {
SETUPwalk
catch {mygraph walk i -command foo -type dfs -dir oneway} msg
mygraph destroy
set msg
} {bad search direction "oneway": must be backward or forward}
test graph-${impl}-${setimpl}-walk-2.5 {walk, bad search order} {
SETUPwalk
catch {mygraph walk i -command foo -order none} msg
mygraph destroy
set msg
} {bad search order "none": must be both, pre, or post}
test graph-${impl}-${setimpl}-walk-2.6 {walk, bad order/type combination} {
SETUPwalk
catch {mygraph walk i -command foo -order both -type bfs} msg
mygraph destroy
set msg
} {unable to do a both-order breadth first walk}
test graph-${impl}-${setimpl}-walk-2.7 {walk, bad order/type combination} {
SETUPwalk
catch {mygraph walk i -command foo -order post -type bfs} msg
mygraph destroy
set msg
} {unable to do a post-order breadth first walk}
# -------------------------------------------------------------------------
# Ok arguments.
proc record {a g n} {global t ; lappend t $a $n ; return}
test graph-${impl}-${setimpl}-walk-3.0 {walk, forward pre dfs, default} {
SETUPwalk
set t {}
mygraph walk i -command record
mygraph destroy
set t
} [tmE {enter i enter ii enter iii enter iv enter v enter vi enter viii enter ix enter vii} \
{enter i enter vii enter vi enter viii enter ix enter ii enter iii enter iv enter v}]
test graph-${impl}-${setimpl}-walk-3.1 {walk, forward post dfs} {
SETUPwalk
set t [list ]
mygraph walk i -order post -command record
mygraph destroy
set t
} [tmE {leave viii leave vi leave v leave iv leave iii leave ii leave ix leave vii leave i} \
{leave viii leave vi leave vii leave ix leave v leave iv leave iii leave ii leave i}]
test graph-${impl}-${setimpl}-walk-3.1.1 {walk, forward post dfs} {
SETUP
mygraph node insert i ii iii
mygraph arc insert i ii 1
mygraph arc insert i iii 2
mygraph arc insert ii iii 3
set t [list ]
mygraph walk i -order post -command record
mygraph destroy
set t
} [tmE {leave iii leave ii leave i} \
{leave iii leave ii leave i}]
test graph-${impl}-${setimpl}-walk-3.2 {walk, forward both dfs} {
SETUPwalk
set t [list ]
mygraph walk i -order both -command record
mygraph destroy
set t
} [tmE {enter i enter ii enter iii enter iv enter v enter vi enter viii leave viii leave vi leave v leave iv leave iii leave ii enter ix leave ix enter vii leave vii leave i} \
{enter i enter vii enter vi enter viii leave viii leave vi leave vii enter ix leave ix enter ii enter iii enter iv enter v leave v leave iv leave iii leave ii leave i}]
test graph-${impl}-${setimpl}-walk-3.3 {walk, forward pre bfs} {
SETUPwalk
set t [list ]
mygraph walk i -type bfs -command record
mygraph destroy
set t
} [tmE {enter i enter ii enter ix enter vii enter iii enter vi enter iv enter viii enter v} \
{enter i enter vii enter ix enter ii enter vi enter iii enter viii enter iv enter v}]
test graph-${impl}-${setimpl}-walk-3.4 {walk, backward pre bfs} {
SETUPwalk
set t [list ]
mygraph walk ix -type bfs -dir backward -command record
mygraph destroy
set t
} [tmE {enter ix enter i enter viii enter vi enter v enter vii enter iv enter iii enter ii} \
{enter ix enter i enter viii enter vi enter vii enter v enter iv enter iii enter ii}]
test graph-${impl}-${setimpl}-walk-3.5 {walk, backward pre dfs} {
SETUPwalk
set t [list ]
mygraph walk ix -dir backward -command record
mygraph destroy
set t
} [tmE {enter ix enter i enter viii enter vi enter v enter iv enter iii enter ii enter vii} \
{enter ix enter i enter viii enter vi enter vii enter v enter iv enter iii enter ii}]
test graph-${impl}-${setimpl}-walk-3.6 {walk, backward post dfs} {
SETUPwalk
set t [list ]
mygraph walk ix -dir backward -order post -command record
mygraph destroy
set t
} [tmE {leave ii leave iii leave iv leave v leave vii leave vi leave viii leave i leave ix} \
{leave vii leave ii leave iii leave iv leave v leave vi leave viii leave i leave ix}]
test graph-${impl}-${setimpl}-walk-3.7 {walk, backward both dfs} {
SETUPwalk
set t [list ]
mygraph walk ix -dir backward -order both -command record
mygraph destroy
set t
} [tmE {enter ix enter i enter viii enter vi enter v enter iv enter iii enter ii leave ii leave iii leave iv leave v enter vii leave vii leave vi leave viii leave i leave ix} \
{enter ix enter i enter viii enter vi enter vii leave vii enter v enter iv enter iii enter ii leave ii leave iii leave iv leave v leave vi leave viii leave i leave ix}]
# -------------------------------------------------------------------------
test graph-${impl}-${setimpl}-tkt.39ab616d8f-walk-4.0 {Ticket 39ab616d8f, dfs pre-order} -setup {
SETUP
mygraph node insert a
mygraph node insert b
mygraph node insert c
mygraph arc insert a b ab
mygraph arc insert b c bc
mygraph arc insert a c ac
# /-> b -\
# a -----> c
set t {}
} -body {
mygraph walk a -command record -dir forward -order pre -type dfs
set t
} -cleanup {
mygraph destroy
unset t
} -result [tmE {enter a enter b enter c} {enter a enter c enter b}]
test graph-${impl}-${setimpl}-tkt.39ab616d8f-walk-4.1 {Ticket 39ab616d8f, dfs pre-order} -setup {
# This is like 4.0, with arcs ab, ac inserted in reverse
# order. This forces the Critcl implementation into the same
# situation as 4.0 does for Tcl, having c in the work stack as
# neighbour of a and then getting visited from b before reahed
# again. Passes.
SETUP
mygraph node insert a
mygraph node insert b
mygraph node insert c
mygraph arc insert a c ac
mygraph arc insert a b ab
mygraph arc insert b c bc
# /-> b -\
# a -----> c
set t {}
} -body {
mygraph walk a -command record -dir forward -order pre -type dfs
set t
} -cleanup {
mygraph destroy
unset t
} -result [tmE {enter a enter c enter b} {enter a enter b enter c}]
# -------------------------------------------------------------------------
rename record {}
# -------------------------------------------------------------------------
|
