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
|