OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [tests/] [obj.test] - Blame information for rev 1767

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
# Functionality covered: this file contains a collection of tests for the
2
# procedures in tclObj.c that implement Tcl's basic type support and the
3
# type managers for the types boolean, double, and integer.
4
#
5
# Sourcing this file into Tcl runs the tests and generates output for
6
# errors. No output means no errors were found.
7
#
8
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
9
#
10
# See the file "license.terms" for information on usage and redistribution
11
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12
#
13
# RCS: @(#) $Id: obj.test,v 1.1.1.1 2002-01-16 10:25:36 markom Exp $
14
 
15
if {[info commands testobj] == {}} {
16
    puts "This application hasn't been compiled with the \"testobj\""
17
    puts "command, so I can't test the Tcl type and object support."
18
    return
19
}
20
 
21
if {[string compare test [info procs test]] == 1} then {source defs}
22
 
23
test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} {
24
    set r 1
25
    foreach {t} {list boolean cmdName bytecode string int double} {
26
        set first [string first $t [testobj types]]
27
        set r [expr {$r && ($first != -1)}]
28
    }
29
    set result $r
30
} {1}
31
 
32
test obj-2.1 {Tcl_GetObjType error} {
33
    list [testintobj set 1 0] [catch {testobj convert 1 foo} msg] $msg
34
} {0 1 {no type foo found}}
35
test obj-2.2 {Tcl_GetObjType and Tcl_ConvertToType} {
36
    set result ""
37
    lappend result [testobj freeallvars]
38
    lappend result [testintobj set 1 12]
39
    lappend result [testobj convert 1 double]
40
    lappend result [testobj type 1]
41
    lappend result [testobj refcount 1]
42
} {{} 12 12 double 3}
43
 
44
test obj-3.1 {Tcl_ConvertToType error} {
45
    list [testdoubleobj set 1 12.34] [catch {testobj convert 1 int} msg] $msg
46
} {12.34 1 {expected integer but got "12.34"}}
47
test obj-3.2 {Tcl_ConvertToType error, "empty string" object} {
48
    list [testobj newobj 1] [catch {testobj convert 1 int} msg] $msg
49
} {{} 1 {expected integer but got ""}}
50
 
51
test obj-4.1 {Tcl_NewObj and AllocateFreeObjects} {
52
    set result ""
53
    lappend result [testobj freeallvars]
54
    lappend result [testobj newobj 1]
55
    lappend result [testobj type 1]
56
    lappend result [testobj refcount 1]
57
} {{} {} string 2}
58
 
59
test obj-5.1 {Tcl_FreeObj} {
60
    set result ""
61
    lappend result [testintobj set 1 12345]
62
    lappend result [testobj freeallvars]
63
    lappend result [catch {testintobj get 1} msg]
64
    lappend result $msg
65
} {12345 {} 1 {variable 1 is unset (NULL)}}
66
 
67
test obj-6.1 {Tcl_DuplicateObj, object has internal rep} {
68
    set result ""
69
    lappend result [testobj freeallvars]
70
    lappend result [testintobj set 1 47]
71
    lappend result [testobj duplicate 1 2]
72
    lappend result [testintobj get 2]
73
    lappend result [testobj refcount 1]
74
    lappend result [testobj refcount 2]
75
} {{} 47 47 47 2 3}
76
test obj-6.2 {Tcl_DuplicateObj, "empty string" object} {
77
    set result ""
78
    lappend result [testobj freeallvars]
79
    lappend result [testobj newobj 1]
80
    lappend result [testobj duplicate 1 2]
81
    lappend result [testintobj get 2]
82
    lappend result [testobj refcount 1]
83
    lappend result [testobj refcount 2]
84
} {{} {} {} {} 2 3}
85
 
86
test obj-7.1 {Tcl_GetStringFromObj, return existing string rep} {
87
    set result ""
88
    lappend result [testintobj set 1 47]
89
    lappend result [testintobj get 1]
90
} {47 47}
91
test obj-7.2 {Tcl_GetStringFromObj, "empty string" object} {
92
    set result ""
93
    lappend result [testobj newobj 1]
94
    lappend result [teststringobj append 1 abc -1]
95
    lappend result [teststringobj get 1]
96
} {{} abc abc}
97
test obj-7.3 {Tcl_GetStringFromObj, returns string internal rep (DString)} {
98
    set result ""
99
    lappend result [teststringobj set 1 xyz]
100
    lappend result [teststringobj append 1 abc -1]
101
    lappend result [teststringobj get 1]
102
} {xyz xyzabc xyzabc}
103
test obj-7.4 {Tcl_GetStringFromObj, recompute string rep from internal rep} {
104
    set result ""
105
    lappend result [testintobj set 1 77]
106
    lappend result [testintobj mult10 1]
107
    lappend result [teststringobj get 1]
108
} {77 770 770}
109
 
110
test obj-8.1 {Tcl_NewBooleanObj} {
111
    set result ""
112
    lappend result [testobj freeallvars]
113
    lappend result [testbooleanobj set 1 0]
114
    lappend result [testobj type 1]
115
    lappend result [testobj refcount 1]
116
} {{} 0 boolean 2}
117
 
118
test obj-9.1 {Tcl_SetBooleanObj, existing "empty string" object} {
119
    set result ""
120
    lappend result [testobj freeallvars]
121
    lappend result [testobj newobj 1]
122
    lappend result [testbooleanobj set 1 0]  ;# makes existing obj boolean
123
    lappend result [testobj type 1]
124
    lappend result [testobj refcount 1]
125
} {{} {} 0 boolean 2}
126
test obj-9.2 {Tcl_SetBooleanObj, existing non-"empty string" object} {
127
    set result ""
128
    lappend result [testobj freeallvars]
129
    lappend result [testintobj set 1 98765]
130
    lappend result [testbooleanobj set 1 1]  ;# makes existing obj boolean
131
    lappend result [testobj type 1]
132
    lappend result [testobj refcount 1]
133
} {{} 98765 1 boolean 2}
134
 
135
test obj-10.1 {Tcl_GetBooleanFromObj, existing boolean object} {
136
    set result ""
137
    lappend result [testbooleanobj set 1 1]
138
    lappend result [testbooleanobj not 1]    ;# gets existing boolean rep
139
} {1 0}
140
test obj-10.2 {Tcl_GetBooleanFromObj, convert to boolean} {
141
    set result ""
142
    lappend result [testintobj set 1 47]
143
    lappend result [testbooleanobj not 1]    ;# must convert to bool
144
    lappend result [testobj type 1]
145
} {47 0 boolean}
146
test obj-10.3 {Tcl_GetBooleanFromObj, error converting to boolean} {
147
    set result ""
148
    lappend result [teststringobj set 1 abc]
149
    lappend result [catch {testbooleanobj not 1} msg]
150
    lappend result $msg
151
} {abc 1 {expected boolean value but got "abc"}}
152
test obj-10.4 {Tcl_GetBooleanFromObj, error converting from "empty string"} {
153
    set result ""
154
    lappend result [testobj newobj 1]
155
    lappend result [catch {testbooleanobj not 1} msg]
156
    lappend result $msg
157
} {{} 1 {expected boolean value but got ""}}
158
 
159
test obj-11.1 {DupBooleanInternalRep} {
160
    set result ""
161
    lappend result [testbooleanobj set 1 1]
162
    lappend result [testobj duplicate 1 2]   ;# uses DupBooleanInternalRep
163
    lappend result [testbooleanobj get 2]
164
} {1 1 1}
165
 
166
test obj-12.1 {SetBooleanFromAny, int to boolean special case} {
167
    set result ""
168
    lappend result [testintobj set 1 1234]
169
    lappend result [testbooleanobj not 1]    ;# converts with SetBooleanFromAny
170
    lappend result [testobj type 1]
171
} {1234 0 boolean}
172
test obj-12.2 {SetBooleanFromAny, double to boolean special case} {
173
    set result ""
174
    lappend result [testdoubleobj set 1 3.14159]
175
    lappend result [testbooleanobj not 1]    ;# converts with SetBooleanFromAny
176
    lappend result [testobj type 1]
177
} {3.14159 0 boolean}
178
test obj-12.3 {SetBooleanFromAny, special case strings representing booleans} {
179
    set result ""
180
    foreach s {yes no true false on off} {
181
        teststringobj set 1 $s
182
        lappend result [testbooleanobj not 1]
183
    }
184
    lappend result [testobj type 1]
185
} {0 1 0 1 0 1 boolean}
186
test obj-12.4 {SetBooleanFromAny, recompute string rep then parse it} {
187
    set result ""
188
    lappend result [testintobj set 1 456]
189
    lappend result [testintobj div10 1]
190
    lappend result [testbooleanobj not 1]    ;# converts with SetBooleanFromAny
191
    lappend result [testobj type 1]
192
} {456 45 0 boolean}
193
test obj-12.5 {SetBooleanFromAny, error parsing string} {
194
    set result ""
195
    lappend result [teststringobj set 1 abc]
196
    lappend result [catch {testbooleanobj not 1} msg]
197
    lappend result $msg
198
} {abc 1 {expected boolean value but got "abc"}}
199
test obj-12.6 {SetBooleanFromAny, error parsing string} {
200
    set result ""
201
    lappend result [teststringobj set 1 x1.0]
202
    lappend result [catch {testbooleanobj not 1} msg]
203
    lappend result $msg
204
} {x1.0 1 {expected boolean value but got "x1.0"}}
205
test obj-12.7 {SetBooleanFromAny, error converting from "empty string"} {
206
    set result ""
207
    lappend result [testobj newobj 1]
208
    lappend result [catch {testbooleanobj not 1} msg]
209
    lappend result $msg
210
} {{} 1 {expected boolean value but got ""}}
211
 
212
test obj-13.1 {UpdateStringOfBoolean} {
213
    set result ""
214
    lappend result [testbooleanobj set 1 0]
215
    lappend result [testbooleanobj not 1]
216
    lappend result [testbooleanobj get 1]    ;# must update string rep
217
} {0 1 1}
218
 
219
test obj-14.1 {Tcl_NewDoubleObj} {
220
    set result ""
221
    lappend result [testobj freeallvars]
222
    lappend result [testdoubleobj set 1 3.1459]
223
    lappend result [testobj type 1]
224
    lappend result [testobj refcount 1]
225
} {{} 3.1459 double 2}
226
 
227
test obj-15.1 {Tcl_SetDoubleObj, existing "empty string" object} {
228
    set result ""
229
    lappend result [testobj freeallvars]
230
    lappend result [testobj newobj 1]
231
    lappend result [testdoubleobj set 1 0.123]  ;# makes existing obj boolean
232
    lappend result [testobj type 1]
233
    lappend result [testobj refcount 1]
234
} {{} {} 0.123 double 2}
235
test obj-15.2 {Tcl_SetDoubleObj, existing non-"empty string" object} {
236
    set result ""
237
    lappend result [testobj freeallvars]
238
    lappend result [testintobj set 1 98765]
239
    lappend result [testdoubleobj set 1 27.56]  ;# makes existing obj double
240
    lappend result [testobj type 1]
241
    lappend result [testobj refcount 1]
242
} {{} 98765 27.56 double 2}
243
 
244
test obj-16.1 {Tcl_GetDoubleFromObj, existing double object} {
245
    set result ""
246
    lappend result [testdoubleobj set 1 16.1]
247
    lappend result [testdoubleobj mult10 1]   ;# gets existing double rep
248
} {16.1 161.0}
249
test obj-16.2 {Tcl_GetDoubleFromObj, convert to double} {
250
    set result ""
251
    lappend result [testintobj set 1 477]
252
    lappend result [testdoubleobj div10 1]    ;# must convert to bool
253
    lappend result [testobj type 1]
254
} {477 47.7 double}
255
test obj-16.3 {Tcl_GetDoubleFromObj, error converting to double} {
256
    set result ""
257
    lappend result [teststringobj set 1 abc]
258
    lappend result [catch {testdoubleobj mult10 1} msg]
259
    lappend result $msg
260
} {abc 1 {expected floating-point number but got "abc"}}
261
test obj-16.4 {Tcl_GetDoubleFromObj, error converting from "empty string"} {
262
    set result ""
263
    lappend result [testobj newobj 1]
264
    lappend result [catch {testdoubleobj div10 1} msg]
265
    lappend result $msg
266
} {{} 1 {expected floating-point number but got ""}}
267
 
268
test obj-17.1 {DupDoubleInternalRep} {
269
    set result ""
270
    lappend result [testdoubleobj set 1 17.1]
271
    lappend result [testobj duplicate 1 2]      ;# uses DupDoubleInternalRep
272
    lappend result [testdoubleobj get 2]
273
} {17.1 17.1 17.1}
274
 
275
test obj-18.1 {SetDoubleFromAny, int to double special case} {
276
    set result ""
277
    lappend result [testintobj set 1 1234]
278
    lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny
279
    lappend result [testobj type 1]
280
} {1234 12340.0 double}
281
test obj-18.2 {SetDoubleFromAny, boolean to double special case} {
282
    set result ""
283
    lappend result [testbooleanobj set 1 1]
284
    lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny
285
    lappend result [testobj type 1]
286
} {1 10.0 double}
287
test obj-18.3 {SetDoubleFromAny, recompute string rep then parse it} {
288
    set result ""
289
    lappend result [testintobj set 1 456]
290
    lappend result [testintobj div10 1]
291
    lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny
292
    lappend result [testobj type 1]
293
} {456 45 450.0 double}
294
test obj-18.4 {SetDoubleFromAny, error parsing string} {
295
    set result ""
296
    lappend result [teststringobj set 1 abc]
297
    lappend result [catch {testdoubleobj mult10 1} msg]
298
    lappend result $msg
299
} {abc 1 {expected floating-point number but got "abc"}}
300
test obj-18.5 {SetDoubleFromAny, error parsing string} {
301
    set result ""
302
    lappend result [teststringobj set 1 x1.0]
303
    lappend result [catch {testdoubleobj mult10 1} msg]
304
    lappend result $msg
305
} {x1.0 1 {expected floating-point number but got "x1.0"}}
306
test obj-18.6 {SetDoubleFromAny, error converting from "empty string"} {
307
    set result ""
308
    lappend result [testobj newobj 1]
309
    lappend result [catch {testdoubleobj div10 1} msg]
310
    lappend result $msg
311
} {{} 1 {expected floating-point number but got ""}}
312
 
313
test obj-19.1 {UpdateStringOfDouble} {
314
    set result ""
315
    lappend result [testdoubleobj set 1 3.14159]
316
    lappend result [testdoubleobj mult10 1]
317
    lappend result [testdoubleobj get 1]   ;# must update string rep
318
} {3.14159 31.4159 31.4159}
319
 
320
test obj-20.1 {Tcl_NewIntObj} {
321
    set result ""
322
    lappend result [testobj freeallvars]
323
    lappend result [testintobj set 1 55]
324
    lappend result [testobj type 1]
325
    lappend result [testobj refcount 1]
326
} {{} 55 int 2}
327
 
328
test obj-21.1 {Tcl_SetIntObj, existing "empty string" object} {
329
    set result ""
330
    lappend result [testobj freeallvars]
331
    lappend result [testobj newobj 1]
332
    lappend result [testintobj set 1 77]  ;# makes existing obj int
333
    lappend result [testobj type 1]
334
    lappend result [testobj refcount 1]
335
} {{} {} 77 int 2}
336
test obj-21.2 {Tcl_SetIntObj, existing non-"empty string" object} {
337
    set result ""
338
    lappend result [testobj freeallvars]
339
    lappend result [testdoubleobj set 1 12.34]
340
    lappend result [testintobj set 1 77]  ;# makes existing obj int
341
    lappend result [testobj type 1]
342
    lappend result [testobj refcount 1]
343
} {{} 12.34 77 int 2}
344
 
345
test obj-22.1 {Tcl_GetIntFromObj, existing int object} {
346
    set result ""
347
    lappend result [testintobj set 1 22]
348
    lappend result [testintobj mult10 1]   ;# gets existing int rep
349
} {22 220}
350
test obj-22.2 {Tcl_GetIntFromObj, convert to int} {
351
    set result ""
352
    lappend result [testintobj set 1 477]
353
    lappend result [testintobj div10 1]    ;# must convert to bool
354
    lappend result [testobj type 1]
355
} {477 47 int}
356
test obj-22.3 {Tcl_GetIntFromObj, error converting to int} {
357
    set result ""
358
    lappend result [teststringobj set 1 abc]
359
    lappend result [catch {testintobj mult10 1} msg]
360
    lappend result $msg
361
} {abc 1 {expected integer but got "abc"}}
362
test obj-22.4 {Tcl_GetIntFromObj, error converting from "empty string"} {
363
    set result ""
364
    lappend result [testobj newobj 1]
365
    lappend result [catch {testintobj div10 1} msg]
366
    lappend result $msg
367
} {{} 1 {expected integer but got ""}}
368
test obj-22.5 {Tcl_GetIntFromObj, integer too large to represent as non-long error} {nonPortable} {
369
    set result ""
370
    lappend result [testobj newobj 1]
371
    lappend result [testintobj inttoobigtest 1]
372
} {{} 1}
373
 
374
test obj-23.1 {DupIntInternalRep} {
375
    set result ""
376
    lappend result [testintobj set 1 23]
377
    lappend result [testobj duplicate 1 2]    ;# uses DupIntInternalRep
378
    lappend result [testintobj get 2]
379
} {23 23 23}
380
 
381
test obj-24.1 {SetIntFromAny, int to int special case} {
382
    set result ""
383
    lappend result [testintobj set 1 1234]
384
    lappend result [testintobj mult10 1]  ;# converts with SetIntFromAny
385
    lappend result [testobj type 1]
386
} {1234 12340 int}
387
test obj-24.2 {SetIntFromAny, boolean to int special case} {
388
    set result ""
389
    lappend result [testbooleanobj set 1 1]
390
    lappend result [testintobj mult10 1]  ;# converts with SetIntFromAny
391
    lappend result [testobj type 1]
392
} {1 10 int}
393
test obj-24.3 {SetIntFromAny, recompute string rep then parse it} {
394
    set result ""
395
    lappend result [testintobj set 1 456]
396
    lappend result [testintobj div10 1]
397
    lappend result [testintobj mult10 1]  ;# converts with SetIntFromAny
398
    lappend result [testobj type 1]
399
} {456 45 450 int}
400
test obj-24.4 {SetIntFromAny, error parsing string} {
401
    set result ""
402
    lappend result [teststringobj set 1 abc]
403
    lappend result [catch {testintobj mult10 1} msg]
404
    lappend result $msg
405
} {abc 1 {expected integer but got "abc"}}
406
test obj-24.5 {SetIntFromAny, error parsing string} {
407
    set result ""
408
    lappend result [teststringobj set 1 x17]
409
    lappend result [catch {testintobj mult10 1} msg]
410
    lappend result $msg
411
} {x17 1 {expected integer but got "x17"}}
412
test obj-24.6 {SetIntFromAny, integer too large} {nonPortable} {
413
    set result ""
414
    lappend result [teststringobj set 1 123456789012345678901]
415
    lappend result [catch {testintobj mult10 1} msg]
416
    lappend result $msg
417
} {123456789012345678901 1 {integer value too large to represent}}
418
test obj-24.7 {SetIntFromAny, error converting from "empty string"} {
419
    set result ""
420
    lappend result [testobj newobj 1]
421
    lappend result [catch {testintobj div10 1} msg]
422
    lappend result $msg
423
} {{} 1 {expected integer but got ""}}
424
 
425
test obj-25.1 {UpdateStringOfInt} {
426
    set result ""
427
    lappend result [testintobj set 1 512]
428
    lappend result [testintobj mult10 1]
429
    lappend result [testintobj get 1]       ;# must update string rep
430
} {512 5120 5120}
431
 
432
test obj-26.1 {Tcl_NewLongObj} {
433
    set result ""
434
    lappend result [testobj freeallvars]
435
    testintobj setmaxlong 1
436
    lappend result [testintobj ismaxlong 1]
437
    lappend result [testobj type 1]
438
    lappend result [testobj refcount 1]
439
} {{} 1 int 1}
440
 
441
test obj-27.1 {Tcl_SetLongObj, existing "empty string" object} {
442
    set result ""
443
    lappend result [testobj freeallvars]
444
    lappend result [testobj newobj 1]
445
    lappend result [testintobj setlong 1 77]  ;# makes existing obj long int
446
    lappend result [testobj type 1]
447
    lappend result [testobj refcount 1]
448
} {{} {} 77 int 2}
449
test obj-27.2 {Tcl_SetLongObj, existing non-"empty string" object} {
450
    set result ""
451
    lappend result [testobj freeallvars]
452
    lappend result [testdoubleobj set 1 12.34]
453
    lappend result [testintobj setlong 1 77]  ;# makes existing obj long int
454
    lappend result [testobj type 1]
455
    lappend result [testobj refcount 1]
456
} {{} 12.34 77 int 2}
457
 
458
test obj-28.1 {Tcl_GetLongFromObj, existing long integer object} {
459
    set result ""
460
    lappend result [testintobj setlong 1 22]
461
    lappend result [testintobj mult10 1]   ;# gets existing long int rep
462
} {22 220}
463
test obj-28.2 {Tcl_GetLongFromObj, convert to long} {
464
    set result ""
465
    lappend result [testintobj setlong 1 477]
466
    lappend result [testintobj div10 1]    ;# must convert to bool
467
    lappend result [testobj type 1]
468
} {477 47 int}
469
test obj-28.3 {Tcl_GetLongFromObj, error converting to long integer} {
470
    set result ""
471
    lappend result [teststringobj set 1 abc]
472
    lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int
473
    lappend result $msg
474
} {abc 1 {expected integer but got "abc"}}
475
test obj-28.4 {Tcl_GetLongFromObj, error converting from "empty string"} {
476
    set result ""
477
    lappend result [testobj newobj 1]
478
    lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int
479
    lappend result $msg
480
} {{} 1 {expected integer but got ""}}
481
 
482
test obj-29.1 {Ref counting and object deletion, simple types} {
483
    set result ""
484
    lappend result [testobj freeallvars]
485
    lappend result [testintobj set 1 1024]
486
    lappend result [testobj assign 1 2]     ;# vars 1 and 2 share the int obj
487
    lappend result [testobj type 2]
488
    lappend result [testobj refcount 1]
489
    lappend result [testobj refcount 2]
490
    lappend result [testbooleanobj set 2 0] ;# must copy on write, now 2 objs
491
    lappend result [testobj type 2]
492
    lappend result [testobj refcount 1]
493
    lappend result [testobj refcount 2]
494
} {{} 1024 1024 int 4 4 0 boolean 3 2}
495
 
496
testobj freeallvars

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.