← Back to branch summary

~ubuntu-branches/ubuntu/utopic/critcl/utopic

« back to all changes in this revision

Viewing changes to test/stubs_container.test

  • Committer: Package Import Robot
  • Author(s): Andrew Shadura
  • Date: 2013-05-11 00:08:06 UTC
  • Revision ID: package-import@ubuntu.com-20130511000806-7hq1zc3fnn0gat79
Tags: upstream-3.1.9
Import upstream version 3.1.9

Show diffs side-by-side

added added

removed removed

Lines of Context:
test/stubs_container.test
 
1
# stubs_container.test -*- tcl -*-
 
2
#
 
3
# $Id: stubs::container.test,v 1.8 2010/07/06 19:39:00 andreas_kupries Exp $
 
4
 
 
5
# -------------------------------------------------------------------------
 
6
 
 
7
source [file join \
 
8
            [file dirname [file join [pwd] [info script]]] \
 
9
            testutilities.tcl]
 
10
 
 
11
testsNeedTcl     8.4
 
12
testsNeedTcltest 2
 
13
 
 
14
support {
 
15
    useLocal lib/util84/lassign.tcl lassign84
 
16
    useLocal lib/util84/dict.tcl    dict84
 
17
}
 
18
testing {
 
19
    useLocal lib/stubs/container.tcl stubs::container
 
20
}
 
21
 
 
22
# -------------------------------------------------------------------------
 
23
# new
 
24
 
 
25
test stubs-container-1.0 {new, wrong\#args} -setup {
 
26
} -body {
 
27
    stubs::container::new X
 
28
} -cleanup {
 
29
} -returnCodes error -result {wrong # args: should be "stubs::container::new"}
 
30
 
 
31
test stubs-container-1.1 {new} -setup {
 
32
    set T [stubs::container::new]
 
33
} -body {
 
34
    lappend R [stubs::container::library?   $T]
 
35
    lappend R [stubs::container::interfaces $T]
 
36
    lappend R [stubs::container::scspec?    $T]
 
37
    lappend R [stubs::container::epoch?     $T]
 
38
    lappend R [stubs::container::revision?  $T]
 
39
    set R
 
40
} -cleanup {
 
41
    unset T R
 
42
} -result {UNKNOWN {} EXTERN {} 0}
 
43
 
 
44
# -------------------------------------------------------------------------
 
45
# library, library?
 
46
 
 
47
test stubs-container-2.0 {library, wrong\#args} -setup {
 
48
} -body {
 
49
    stubs::container::library
 
50
} -cleanup {
 
51
} -returnCodes error -result {wrong # args: should be "stubs::container::library tablevar name"}
 
52
 
 
53
test stubs-container-2.1 {library, wrong\#args} -setup {
 
54
} -body {
 
55
    stubs::container::library T
 
56
} -cleanup {
 
57
} -returnCodes error -result {wrong # args: should be "stubs::container::library tablevar name"}
 
58
 
 
59
test stubs-container-2.2 {library, wrong\#args} -setup {
 
60
} -body {
 
61
    stubs::container::library T x y
 
62
} -cleanup {
 
63
} -returnCodes error -result {wrong # args: should be "stubs::container::library tablevar name"}
 
64
 
 
65
test stubs-container-2.3 {library?, wrong\#args} -setup {
 
66
} -body {
 
67
    stubs::container::library?
 
68
} -cleanup {
 
69
} -returnCodes error -result {wrong # args: should be "stubs::container::library? table"}
 
70
 
 
71
test stubs-container-2.4 {library?, wrong\#args} -setup {
 
72
} -body {
 
73
    stubs::container::library? T X
 
74
} -cleanup {
 
75
} -returnCodes error -result {wrong # args: should be "stubs::container::library? table"}
 
76
 
 
77
test stubs-container-2.5 {library, set/get} -setup {
 
78
    set T [stubs::container::new]
 
79
} -body {
 
80
    lappend R [stubs::container::library?   $T]
 
81
    stubs::container::library T TEST
 
82
    lappend R [stubs::container::library?   $T]
 
83
    set R
 
84
} -cleanup {
 
85
    unset T R
 
86
} -result {UNKNOWN TEST}
 
87
 
 
88
# -------------------------------------------------------------------------
 
89
# scspec, scspec?
 
90
 
 
91
test stubs-container-3.0 {scspec, wrong\#args} -setup {
 
92
} -body {
 
93
    stubs::container::scspec
 
94
} -cleanup {
 
95
} -returnCodes error -result {wrong # args: should be "stubs::container::scspec tablevar value"}
 
96
 
 
97
test stubs-container-3.1 {scspec, wrong\#args} -setup {
 
98
} -body {
 
99
    stubs::container::scspec T
 
100
} -cleanup {
 
101
} -returnCodes error -result {wrong # args: should be "stubs::container::scspec tablevar value"}
 
102
 
 
103
test stubs-container-3.2 {scspec, wrong\#args} -setup {
 
104
} -body {
 
105
    stubs::container::scspec T x y
 
106
} -cleanup {
 
107
} -returnCodes error -result {wrong # args: should be "stubs::container::scspec tablevar value"}
 
108
 
 
109
test stubs-container-3.3 {scspec?, wrong\#args} -setup {
 
110
} -body {
 
111
    stubs::container::scspec?
 
112
} -cleanup {
 
113
} -returnCodes error -result {wrong # args: should be "stubs::container::scspec? table"}
 
114
 
 
115
test stubs-container-3.4 {scspec?, wrong\#args} -setup {
 
116
} -body {
 
117
    stubs::container::scspec? T X
 
118
} -cleanup {
 
119
} -returnCodes error -result {wrong # args: should be "stubs::container::scspec? table"}
 
120
 
 
121
test stubs-container-3.5 {scspec, set/get} -setup {
 
122
    set T [stubs::container::new]
 
123
} -body {
 
124
    lappend R [stubs::container::scspec?   $T]
 
125
    stubs::container::scspec T TEST
 
126
    lappend R [stubs::container::scspec?   $T]
 
127
    set R
 
128
} -cleanup {
 
129
    unset T R
 
130
} -result {EXTERN TEST}
 
131
 
 
132
# -------------------------------------------------------------------------
 
133
# epoch, epoch?
 
134
 
 
135
test stubs-container-4.0 {epoch, wrong\#args} -setup {
 
136
} -body {
 
137
    stubs::container::epoch
 
138
} -cleanup {
 
139
} -returnCodes error -result {wrong # args: should be "stubs::container::epoch tablevar value"}
 
140
 
 
141
test stubs-container-4.1 {epoch, wrong\#args} -setup {
 
142
} -body {
 
143
    stubs::container::epoch T
 
144
} -cleanup {
 
145
} -returnCodes error -result {wrong # args: should be "stubs::container::epoch tablevar value"}
 
146
 
 
147
test stubs-container-4.2 {epoch, wrong\#args} -setup {
 
148
} -body {
 
149
    stubs::container::epoch T x y
 
150
} -cleanup {
 
151
} -returnCodes error -result {wrong # args: should be "stubs::container::epoch tablevar value"}
 
152
 
 
153
test stubs-container-4.3 {epoch?, wrong\#args} -setup {
 
154
} -body {
 
155
    stubs::container::epoch?
 
156
} -cleanup {
 
157
} -returnCodes error -result {wrong # args: should be "stubs::container::epoch? table"}
 
158
 
 
159
test stubs-container-4.4 {epoch?, wrong\#args} -setup {
 
160
} -body {
 
161
    stubs::container::epoch? T X
 
162
} -cleanup {
 
163
} -returnCodes error -result {wrong # args: should be "stubs::container::epoch? table"}
 
164
 
 
165
test stubs-container-4.5 {epoch, set/get, bad value, not integer} -setup {
 
166
    set T [stubs::container::new]
 
167
} -body {
 
168
    stubs::container::epoch T TEST
 
169
} -cleanup {
 
170
    unset T
 
171
} -returnCodes error -result {Expected integer for epoch, but got "TEST"}
 
172
 
 
173
test stubs-container-4.6 {epoch, set/get} -setup {
 
174
    set T [stubs::container::new]
 
175
} -body {
 
176
    lappend R [stubs::container::epoch?   $T]
 
177
    stubs::container::epoch T 42
 
178
    lappend R [stubs::container::epoch?   $T]
 
179
    set R
 
180
} -cleanup {
 
181
    unset T R
 
182
} -result {{} 42}
 
183
 
 
184
# -------------------------------------------------------------------------
 
185
# interface, interfaces
 
186
 
 
187
test stubs-container-5.0 {interface, wrong\#args} -setup {
 
188
} -body {
 
189
    stubs::container::interface
 
190
} -cleanup {
 
191
} -returnCodes error -result {wrong # args: should be "stubs::container::interface tablevar name"}
 
192
 
 
193
test stubs-container-5.1 {interface, wrong\#args} -setup {
 
194
} -body {
 
195
    stubs::container::interface T
 
196
} -cleanup {
 
197
} -returnCodes error -result {wrong # args: should be "stubs::container::interface tablevar name"}
 
198
 
 
199
test stubs-container-5.2 {interface, wrong\#args} -setup {
 
200
} -body {
 
201
    stubs::container::interface T x y
 
202
} -cleanup {
 
203
} -returnCodes error -result {wrong # args: should be "stubs::container::interface tablevar name"}
 
204
 
 
205
test stubs-container-5.3 {interfaces, wrong\#args} -setup {
 
206
} -body {
 
207
    stubs::container::interfaces
 
208
} -cleanup {
 
209
} -returnCodes error -result {wrong # args: should be "stubs::container::interfaces table"}
 
210
 
 
211
test stubs-container-5.4 {interfaces, wrong\#args} -setup {
 
212
} -body {
 
213
    stubs::container::interfaces T X
 
214
} -cleanup {
 
215
} -returnCodes error -result {wrong # args: should be "stubs::container::interfaces table"}
 
216
 
 
217
test stubs-container-5.5 {interface(s), set/get} -setup {
 
218
    set T [stubs::container::new]
 
219
} -body {
 
220
    lappend R [stubs::container::interfaces   $T]
 
221
    stubs::container::interface T TEST
 
222
    lappend R [stubs::container::interfaces   $T]
 
223
    stubs::container::interface T FOO
 
224
    lappend R [stubs::container::interfaces   $T]
 
225
    set R
 
226
} -cleanup {
 
227
    unset T R
 
228
} -result {{} TEST {TEST FOO}}
 
229
 
 
230
test stubs-container-5.6 {interface, duplicate declaration} -setup {
 
231
    set T [stubs::container::new]
 
232
    stubs::container::interface T A
 
233
} -body {
 
234
    stubs::container::interface T A
 
235
} -cleanup {
 
236
    unset T
 
237
} -returnCodes error -result {Duplicate declaration of interface "A"}
 
238
 
 
239
# -------------------------------------------------------------------------
 
240
# hooks, hooks?, hooksof
 
241
 
 
242
test stubs-container-6.0 {hooks, wrong\#args} -setup {
 
243
} -body {
 
244
    stubs::container::hooks
 
245
} -cleanup {
 
246
} -returnCodes error -result {wrong # args: should be "stubs::container::hooks tablevar interface names"}
 
247
 
 
248
test stubs-container-6.1 {hooks, wrong\#args} -setup {
 
249
} -body {
 
250
    stubs::container::hooks T
 
251
} -cleanup {
 
252
} -returnCodes error -result {wrong # args: should be "stubs::container::hooks tablevar interface names"}
 
253
 
 
254
test stubs-container-6.2 {hooks, wrong\#args} -setup {
 
255
} -body {
 
256
    stubs::container::hooks T x
 
257
} -cleanup {
 
258
} -returnCodes error -result {wrong # args: should be "stubs::container::hooks tablevar interface names"}
 
259
 
 
260
test stubs-container-6.3 {hooks, wrong\#args} -setup {
 
261
} -body {
 
262
    stubs::container::hooks T x y z
 
263
} -cleanup {
 
264
} -returnCodes error -result {wrong # args: should be "stubs::container::hooks tablevar interface names"}
 
265
 
 
266
test stubs-container-6.4 {hooksof, wrong\#args} -setup {
 
267
} -body {
 
268
    stubs::container::hooksof
 
269
} -cleanup {
 
270
} -returnCodes error -result {wrong # args: should be "stubs::container::hooksof table interface"}
 
271
 
 
272
test stubs-container-6.5 {hooksof, wrong\#args} -setup {
 
273
} -body {
 
274
    stubs::container::hooksof T
 
275
} -cleanup {
 
276
} -returnCodes error -result {wrong # args: should be "stubs::container::hooksof table interface"}
 
277
 
 
278
test stubs-container-6.6 {hooksof, wrong\#args} -setup {
 
279
} -body {
 
280
    stubs::container::hooksof T x y
 
281
} -cleanup {
 
282
} -returnCodes error -result {wrong # args: should be "stubs::container::hooksof table interface"}
 
283
 
 
284
test stubs-container-6.7 {hooks?, wrong\#args} -setup {
 
285
} -body {
 
286
    stubs::container::hooks?
 
287
} -cleanup {
 
288
} -returnCodes error -result {wrong # args: should be "stubs::container::hooks? table interface"}
 
289
 
 
290
test stubs-container-6.8 {hooks?, wrong\#args} -setup {
 
291
} -body {
 
292
    stubs::container::hooks? T
 
293
} -cleanup {
 
294
} -returnCodes error -result {wrong # args: should be "stubs::container::hooks? table interface"}
 
295
 
 
296
test stubs-container-6.9 {hooks?, wrong\#args} -setup {
 
297
} -body {
 
298
    stubs::container::hooks? T x y
 
299
} -cleanup {
 
300
} -returnCodes error -result {wrong # args: should be "stubs::container::hooks? table interface"}
 
301
 
 
302
test stubs-container-6.10 {hooks, hooksof, hooks?, set/get} -setup {
 
303
    set T [stubs::container::new]
 
304
    stubs::container::interface T A
 
305
    stubs::container::interface T B
 
306
    stubs::container::hooks T A {B C}
 
307
} -body {
 
308
    lappend R [stubs::container::hooks?  $T A]
 
309
    lappend R [stubs::container::hooks?  $T B]
 
310
    lappend R [stubs::container::hooksof $T A]
 
311
    lappend R [stubs::container::hooksof $T B]
 
312
    set R
 
313
} -cleanup {
 
314
    unset T R
 
315
} -result {1 0 {B C} {}}
 
316
 
 
317
test stubs-container-6.11 {hooksof, unknown interface} -setup {
 
318
    set T [stubs::container::new]
 
319
} -body {
 
320
    stubs::container::hooksof $T A
 
321
} -cleanup {
 
322
    unset T
 
323
} -returnCodes error -result {Unknown interface "A"}
 
324
 
 
325
test stubs-container-6.12 {hooks?, unknown interface} -setup {
 
326
    set T [stubs::container::new]
 
327
} -body {
 
328
    stubs::container::hooks? $T A
 
329
} -cleanup {
 
330
    unset T
 
331
} -returnCodes error -result {Unknown interface "A"}
 
332
 
 
333
# -------------------------------------------------------------------------
 
334
# platforms
 
335
 
 
336
test stubs-container-7.0 {platforms, wrong\#args} -setup {
 
337
} -body {
 
338
    stubs::container::platforms
 
339
} -cleanup {
 
340
} -returnCodes error -result {wrong # args: should be "stubs::container::platforms table interface"}
 
341
 
 
342
test stubs-container-7.1 {platforms, wrong\#args} -setup {
 
343
} -body {
 
344
    stubs::container::platforms T
 
345
} -cleanup {
 
346
} -returnCodes error -result {wrong # args: should be "stubs::container::platforms table interface"}
 
347
 
 
348
test stubs-container-7.2 {platforms, wrong\#args} -setup {
 
349
} -body {
 
350
    stubs::container::platforms T x y
 
351
} -cleanup {
 
352
} -returnCodes error -result {wrong # args: should be "stubs::container::platforms table interface"}
 
353
 
 
354
test stubs-container-7.3 {platforms} -setup {
 
355
    set T [stubs::container::new]
 
356
    stubs::container::interface T A
 
357
    stubs::container::interface T B
 
358
    stubs::container::declare   T B 5 generic _foo_
 
359
} -body {
 
360
    lappend R [stubs::container::platforms $T A]
 
361
    lappend R [stubs::container::platforms $T B]
 
362
    set R
 
363
} -cleanup {
 
364
    unset T R
 
365
} -result {{} generic}
 
366
 
 
367
test stubs-container-7.4 {platforms, unknown interface} -setup {
 
368
    set T [stubs::container::new]
 
369
} -body {
 
370
    stubs::container::platforms $T A
 
371
} -cleanup {
 
372
    unset T
 
373
} -returnCodes error -result {Unknown interface "A"}
 
374
 
 
375
# -------------------------------------------------------------------------
 
376
# lastof
 
377
 
 
378
test stubs-container-8.0 {lastof, wrong\#args} -setup {
 
379
} -body {
 
380
    stubs::container::lastof
 
381
} -cleanup {
 
382
} -returnCodes error -result {wrong # args: should be "stubs::container::lastof table interface ?platform?"}
 
383
 
 
384
test stubs-container-8.1 {lastof, wrong\#args} -setup {
 
385
} -body {
 
386
    stubs::container::lastof T
 
387
} -cleanup {
 
388
} -returnCodes error -result {wrong # args: should be "stubs::container::lastof table interface ?platform?"}
 
389
 
 
390
test stubs-container-8.2 {lastof, wrong\#args} -setup {
 
391
} -body {
 
392
    stubs::container::lastof T x y z a
 
393
} -cleanup {
 
394
} -returnCodes error -result {wrong # args: should be "stubs::container::lastof table interface ?platform?"}
 
395
 
 
396
test stubs-container-8.3 {lastof, all} -setup {
 
397
    set T [stubs::container::new]
 
398
    stubs::container::interface T A
 
399
    stubs::container::interface T B
 
400
    stubs::container::declare   T B 5 generic _foo_
 
401
} -body {
 
402
    lappend R [stubs::container::lastof $T A] ; # note empty          list!
 
403
    lappend R [stubs::container::lastof $T B] ; # note single element list!
 
404
    set R
 
405
} -cleanup {
 
406
    unset T R
 
407
} -result {{} 5}
 
408
 
 
409
test stubs-container-8.3.1 {lastof, all} -setup {
 
410
    set T [stubs::container::new]
 
411
    stubs::container::interface T A
 
412
    stubs::container::interface T B
 
413
    stubs::container::declare   T B 5 generic _bogus_
 
414
    stubs::container::declare   T B 7 aqua    _bogus_
 
415
} -body {
 
416
    lappend R              [stubs::container::lastof $T A]  ; # note empty list!
 
417
    lappend R [lsort -dict [stubs::container::lastof $T B]] ; # note list!
 
418
    set R
 
419
} -cleanup {
 
420
    unset T R
 
421
} -result {{} {5 7}}
 
422
 
 
423
test stubs-container-8.4 {lastof, by platform} -setup {
 
424
    set T [stubs::container::new]
 
425
    stubs::container::interface T A
 
426
    stubs::container::interface T B
 
427
    stubs::container::declare   T B 5 generic _foo_
 
428
} -body {
 
429
    lappend R [stubs::container::lastof $T A generic]
 
430
    lappend R [stubs::container::lastof $T B generic]
 
431
    set R
 
432
} -cleanup {
 
433
    unset T R
 
434
} -result {-1 5}
 
435
 
 
436
test stubs-container-8.5 {lastof, unknown interface} -setup {
 
437
    set T [stubs::container::new]
 
438
} -body {
 
439
    stubs::container::lastof $T A
 
440
} -cleanup {
 
441
    unset T
 
442
} -returnCodes error -result {Unknown interface "A"}
 
443
 
 
444
# -------------------------------------------------------------------------
 
445
# slot?
 
446
 
 
447
test stubs-container-9.0 {slot?, wrong\#args} -setup {
 
448
} -body {
 
449
    stubs::container::slot?
 
450
} -cleanup {
 
451
} -returnCodes error -result {wrong # args: should be "stubs::container::slot? table interface platform at"}
 
452
 
 
453
test stubs-container-9.1 {slot?, wrong\#args} -setup {
 
454
} -body {
 
455
    stubs::container::slot? T
 
456
} -cleanup {
 
457
} -returnCodes error -result {wrong # args: should be "stubs::container::slot? table interface platform at"}
 
458
 
 
459
test stubs-container-9.2 {slot?, wrong\#args} -setup {
 
460
} -body {
 
461
    stubs::container::slot? T x
 
462
} -cleanup {
 
463
} -returnCodes error -result {wrong # args: should be "stubs::container::slot? table interface platform at"}
 
464
 
 
465
test stubs-container-9.3 {slot?, wrong\#args} -setup {
 
466
} -body {
 
467
    stubs::container::slot? T x y
 
468
} -cleanup {
 
469
} -returnCodes error -result {wrong # args: should be "stubs::container::slot? table interface platform at"}
 
470
 
 
471
test stubs-container-9.4 {slot?, wrong\#args} -setup {
 
472
} -body {
 
473
    stubs::container::slot? T x y z a
 
474
} -cleanup {
 
475
} -returnCodes error -result {wrong # args: should be "stubs::container::slot? table interface platform at"}
 
476
 
 
477
test stubs-container-9.5 {slot?, unknown interface} -setup {
 
478
    set T [stubs::container::new]
 
479
} -body {
 
480
    stubs::container::slot? $T A y z
 
481
} -cleanup {
 
482
    unset T
 
483
} -returnCodes error -result {Unknown interface "A"}
 
484
 
 
485
test stubs-container-9.6 {slot?, unknown platform, slot} -setup {
 
486
    set T [stubs::container::new]
 
487
    stubs::container::interface T A
 
488
} -body {
 
489
    stubs::container::slot? $T A y z
 
490
} -cleanup {
 
491
    unset T
 
492
} -result 0
 
493
 
 
494
test stubs-container-9.7 {slot?} -setup {
 
495
    set T [stubs::container::new]
 
496
    stubs::container::interface T A
 
497
    stubs::container::declare   T A 5 generic _foo_
 
498
} -body {
 
499
    stubs::container::slot? $T A generic 5
 
500
} -cleanup {
 
501
    unset T
 
502
} -result 1
 
503
 
 
504
# -------------------------------------------------------------------------
 
505
# slot
 
506
 
 
507
test stubs-container-10.0 {slot, wrong\#args} -setup {
 
508
} -body {
 
509
    stubs::container::slot
 
510
} -cleanup {
 
511
} -returnCodes error -result {wrong # args: should be "stubs::container::slot table interface platform at"}
 
512
 
 
513
test stubs-container-10.1 {slot, wrong\#args} -setup {
 
514
} -body {
 
515
    stubs::container::slot T
 
516
} -cleanup {
 
517
} -returnCodes error -result {wrong # args: should be "stubs::container::slot table interface platform at"}
 
518
 
 
519
test stubs-container-10.2 {slot, wrong\#args} -setup {
 
520
} -body {
 
521
    stubs::container::slot T x
 
522
} -cleanup {
 
523
} -returnCodes error -result {wrong # args: should be "stubs::container::slot table interface platform at"}
 
524
 
 
525
test stubs-container-10.3 {slot, wrong\#args} -setup {
 
526
} -body {
 
527
    stubs::container::slot T x y
 
528
} -cleanup {
 
529
} -returnCodes error -result {wrong # args: should be "stubs::container::slot table interface platform at"}
 
530
 
 
531
test stubs-container-10.4 {slot, wrong\#args} -setup {
 
532
} -body {
 
533
    stubs::container::slot T x y z a
 
534
} -cleanup {
 
535
} -returnCodes error -result {wrong # args: should be "stubs::container::slot table interface platform at"}
 
536
 
 
537
test stubs-container-10.5 {slot, unknown interface} -setup {
 
538
    set T [stubs::container::new]
 
539
} -body {
 
540
    stubs::container::slot $T A y z
 
541
} -cleanup {
 
542
    unset T
 
543
} -returnCodes error -result {Unknown interface "A"}
 
544
 
 
545
test stubs-container-10.6 {slot, unknown platform, slot} -setup {
 
546
    set T [stubs::container::new]
 
547
    stubs::container::interface T A
 
548
} -body {
 
549
    stubs::container::slot $T A y z
 
550
} -cleanup {
 
551
    unset T
 
552
} -returnCodes error -result {Unknown slot "y,z"}
 
553
 
 
554
test stubs-container-10.7 {slot} -setup {
 
555
    set T [stubs::container::new]
 
556
    stubs::container::interface T A
 
557
    stubs::container::declare   T A 5 generic _foo_
 
558
} -body {
 
559
    stubs::container::slot $T A generic 5
 
560
} -cleanup {
 
561
    unset T
 
562
} -result _foo_
 
563
 
 
564
# -------------------------------------------------------------------------
 
565
# slotplatforms
 
566
 
 
567
test stubs-container-11.0 {slotplatforms, wrong\#args} -setup {
 
568
} -body {
 
569
    stubs::container::slotplatforms
 
570
} -cleanup {
 
571
} -returnCodes error -result {wrong # args: should be "stubs::container::slotplatforms table interface at"}
 
572
 
 
573
test stubs-container-11.1 {slotplatforms, wrong\#args} -setup {
 
574
} -body {
 
575
    stubs::container::slotplatforms T
 
576
} -cleanup {
 
577
} -returnCodes error -result {wrong # args: should be "stubs::container::slotplatforms table interface at"}
 
578
 
 
579
test stubs-container-11.2 {slotplatforms, wrong\#args} -setup {
 
580
} -body {
 
581
    stubs::container::slotplatforms T x
 
582
} -cleanup {
 
583
} -returnCodes error -result {wrong # args: should be "stubs::container::slotplatforms table interface at"}
 
584
 
 
585
test stubs-container-11.3 {slotplatforms, wrong\#args} -setup {
 
586
} -body {
 
587
    stubs::container::slotplatforms T x y a
 
588
} -cleanup {
 
589
} -returnCodes error -result {wrong # args: should be "stubs::container::slotplatforms table interface at"}
 
590
 
 
591
test stubs-container-11.4 {slotplatforms, unknown interface} -setup {
 
592
    set T [stubs::container::new]
 
593
} -body {
 
594
    stubs::container::slotplatforms $T A y
 
595
} -cleanup {
 
596
    unset T
 
597
} -returnCodes error -result {Unknown interface "A"}
 
598
 
 
599
test stubs-container-11.5 {slotplatforms, unknown slot} -setup {
 
600
    set T [stubs::container::new]
 
601
    stubs::container::interface T A
 
602
    stubs::container::declare   T A 5 generic _foo_
 
603
} -body {
 
604
    stubs::container::slotplatforms $T A 4
 
605
} -cleanup {
 
606
    unset T
 
607
} -result {}
 
608
 
 
609
test stubs-container-11.6 {slotplatforms} -setup {
 
610
    set T [stubs::container::new]
 
611
    stubs::container::interface T A
 
612
    stubs::container::declare   T A 5 generic _foo_
 
613
} -body {
 
614
    stubs::container::slotplatforms $T A 5
 
615
} -cleanup {
 
616
    unset T
 
617
} -result generic
 
618
 
 
619
# -------------------------------------------------------------------------
 
620
## Representation overview, basics.
 
621
 
 
622
test stubs-container-12.0 {print, wrong\#args} -setup {
 
623
} -body {
 
624
    stubs::container::print
 
625
} -cleanup {
 
626
} -returnCodes error -result {wrong # args: should be "stubs::container::print table"}
 
627
 
 
628
test stubs-container-12.1 {print, wrong\#args} -setup {
 
629
} -body {
 
630
    stubs::container::print T x
 
631
} -cleanup {
 
632
} -returnCodes error -result {wrong # args: should be "stubs::container::print table"}
 
633
 
 
634
test stubs-container-12.2 {print, empty} -setup {
 
635
    set T [stubs::container::new]
 
636
} -body {
 
637
    stubs::container::print $T
 
638
} -cleanup {
 
639
    unset T
 
640
} -result {stubs UNKNOWN {
 
641
    scspec   EXTERN
 
642
    epoch    {}
 
643
    revision 0
 
644
}}
 
645
 
 
646
test stubs-container-12.3 {print, global settings} -setup {
 
647
    set T [stubs::container::new]
 
648
    stubs::container::library T TEST
 
649
    stubs::container::scspec  T ZEXTERN
 
650
    stubs::container::epoch   T 1
 
651
} -body {
 
652
    stubs::container::print $T
 
653
} -cleanup {
 
654
    unset T
 
655
} -result {stubs TEST {
 
656
    scspec   ZEXTERN
 
657
    epoch    1
 
658
    revision 0
 
659
}}
 
660
 
 
661
test stubs-container-12.4 {print, interface} -setup {
 
662
    set T [stubs::container::new]
 
663
    stubs::container::library   T TEST
 
664
    stubs::container::scspec    T ZEXTERN
 
665
    stubs::container::epoch     T 1
 
666
    stubs::container::interface T A
 
667
} -body {
 
668
    stubs::container::print $T
 
669
} -cleanup {
 
670
    unset T
 
671
} -result {stubs TEST {
 
672
    scspec   ZEXTERN
 
673
    epoch    1
 
674
    revision 0
 
675
    interface A {
 
676
        hooks {}
 
677
    }
 
678
}}
 
679
 
 
680
test stubs-container-12.5 {print, interface with hooks} -setup {
 
681
    set T [stubs::container::new]
 
682
    stubs::container::library   T TEST
 
683
    stubs::container::scspec    T ZEXTERN
 
684
    stubs::container::epoch     T 1
 
685
    stubs::container::interface T A
 
686
    stubs::container::interface T B
 
687
    stubs::container::interface T C
 
688
    stubs::container::hooks     T A {B C}
 
689
} -body {
 
690
    stubs::container::print $T
 
691
} -cleanup {
 
692
    unset T
 
693
} -result {stubs TEST {
 
694
    scspec   ZEXTERN
 
695
    epoch    1
 
696
    revision 0
 
697
    interface A {
 
698
        hooks {B C}
 
699
    }
 
700
    interface B {
 
701
        hooks {}
 
702
    }
 
703
    interface C {
 
704
        hooks {}
 
705
    }
 
706
}}
 
707
 
 
708
test stubs-container-12.6 {print, declarations} -setup {
 
709
    set T [stubs::container::new]
 
710
    stubs::container::library   T TEST
 
711
    stubs::container::scspec    T ZEXTERN
 
712
    stubs::container::epoch     T 1
 
713
    stubs::container::interface T A
 
714
    stubs::container::declare   T A 5 generic _bar_
 
715
    stubs::container::declare   T A 5 {x11 aqua} _foo_
 
716
} -body {
 
717
    stubs::container::print $T
 
718
} -cleanup {
 
719
    unset T
 
720
} -result {stubs TEST {
 
721
    scspec   ZEXTERN
 
722
    epoch    1
 
723
    revision 2
 
724
    interface A {
 
725
        hooks {}
 
726
        declare 5 generic {
 
727
            function {}
 
728
            return _bar_
 
729
        }
 
730
        declare 5 {aqua x11} {
 
731
            function {}
 
732
            return _foo_
 
733
        }
 
734
    }
 
735
}}
 
736
 
 
737
# -------------------------------------------------------------------------
 
738
 
 
739
testsuiteCleanup
 
740
 
 
741
# Local variables:
 
742
# mode: tcl
 
743
# indent-tabs-mode: nil
 
744
# End: