sl@0
|
1 |
# Functionality covered: this file contains a collection of tests for the
|
sl@0
|
2 |
# procedures in tclObj.c that implement Tcl's basic type support and the
|
sl@0
|
3 |
# type managers for the types boolean, double, and integer.
|
sl@0
|
4 |
#
|
sl@0
|
5 |
# Sourcing this file into Tcl runs the tests and generates output for
|
sl@0
|
6 |
# errors. No output means no errors were found.
|
sl@0
|
7 |
#
|
sl@0
|
8 |
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
|
sl@0
|
9 |
# Copyright (c) 1998-1999 by Scriptics Corporation.
|
sl@0
|
10 |
#
|
sl@0
|
11 |
# See the file "license.terms" for information on usage and redistribution
|
sl@0
|
12 |
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
sl@0
|
13 |
#
|
sl@0
|
14 |
# RCS: @(#) $Id: obj.test,v 1.7.2.1 2004/09/10 21:52:37 dkf Exp $
|
sl@0
|
15 |
|
sl@0
|
16 |
if {[lsearch [namespace children] ::tcltest] == -1} {
|
sl@0
|
17 |
package require tcltest
|
sl@0
|
18 |
namespace import -force ::tcltest::*
|
sl@0
|
19 |
}
|
sl@0
|
20 |
|
sl@0
|
21 |
if {[info commands testobj] == {}} {
|
sl@0
|
22 |
puts "This application hasn't been compiled with the \"testobj\""
|
sl@0
|
23 |
puts "command, so I can't test the Tcl type and object support."
|
sl@0
|
24 |
::tcltest::cleanupTests
|
sl@0
|
25 |
return
|
sl@0
|
26 |
}
|
sl@0
|
27 |
|
sl@0
|
28 |
# Procedure to determine the integer range of the machine
|
sl@0
|
29 |
|
sl@0
|
30 |
proc int_range {} {
|
sl@0
|
31 |
for { set MIN_INT 1 } { $MIN_INT > 0 } {} {
|
sl@0
|
32 |
set MIN_INT [expr { $MIN_INT << 1 }]
|
sl@0
|
33 |
}
|
sl@0
|
34 |
set MAX_INT [expr { ~ $MIN_INT }]
|
sl@0
|
35 |
return [list $MIN_INT $MAX_INT]
|
sl@0
|
36 |
}
|
sl@0
|
37 |
|
sl@0
|
38 |
# Procedure to determine the range of wide integers on the machine.
|
sl@0
|
39 |
|
sl@0
|
40 |
proc wide_range {} {
|
sl@0
|
41 |
for { set MIN_WIDE [expr { wide(1) }] } { $MIN_WIDE > wide(0) } {} {
|
sl@0
|
42 |
set MIN_WIDE [expr { $MIN_WIDE << 1 }]
|
sl@0
|
43 |
}
|
sl@0
|
44 |
set MAX_WIDE [expr { ~ $MIN_WIDE }]
|
sl@0
|
45 |
return [list $MIN_WIDE $MAX_WIDE]
|
sl@0
|
46 |
}
|
sl@0
|
47 |
|
sl@0
|
48 |
foreach { MIN_INT MAX_INT } [int_range] break
|
sl@0
|
49 |
foreach { MIN_WIDE MAX_WIDE } [wide_range] break
|
sl@0
|
50 |
::tcltest::testConstraint 32bit \
|
sl@0
|
51 |
[expr { $MAX_INT == 0x7fffffff }]
|
sl@0
|
52 |
::tcltest::testConstraint wideBiggerThanInt \
|
sl@0
|
53 |
[expr { $MAX_WIDE > wide($MAX_INT) }]
|
sl@0
|
54 |
|
sl@0
|
55 |
test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} {
|
sl@0
|
56 |
set r 1
|
sl@0
|
57 |
foreach {t} {
|
sl@0
|
58 |
{array search}
|
sl@0
|
59 |
boolean
|
sl@0
|
60 |
bytearray
|
sl@0
|
61 |
bytecode
|
sl@0
|
62 |
double
|
sl@0
|
63 |
end-offset
|
sl@0
|
64 |
index
|
sl@0
|
65 |
int
|
sl@0
|
66 |
list
|
sl@0
|
67 |
nsName
|
sl@0
|
68 |
procbody
|
sl@0
|
69 |
string
|
sl@0
|
70 |
} {
|
sl@0
|
71 |
set first [string first $t [testobj types]]
|
sl@0
|
72 |
set r [expr {$r && ($first != -1)}]
|
sl@0
|
73 |
}
|
sl@0
|
74 |
set result $r
|
sl@0
|
75 |
} {1}
|
sl@0
|
76 |
|
sl@0
|
77 |
test obj-2.1 {Tcl_GetObjType error} {
|
sl@0
|
78 |
list [testintobj set 1 0] [catch {testobj convert 1 foo} msg] $msg
|
sl@0
|
79 |
} {0 1 {no type foo found}}
|
sl@0
|
80 |
test obj-2.2 {Tcl_GetObjType and Tcl_ConvertToType} {
|
sl@0
|
81 |
set result ""
|
sl@0
|
82 |
lappend result [testobj freeallvars]
|
sl@0
|
83 |
lappend result [testintobj set 1 12]
|
sl@0
|
84 |
lappend result [testobj convert 1 double]
|
sl@0
|
85 |
lappend result [testobj type 1]
|
sl@0
|
86 |
lappend result [testobj refcount 1]
|
sl@0
|
87 |
} {{} 12 12 double 3}
|
sl@0
|
88 |
|
sl@0
|
89 |
test obj-3.1 {Tcl_ConvertToType error} {
|
sl@0
|
90 |
list [testdoubleobj set 1 12.34] [catch {testobj convert 1 int} msg] $msg
|
sl@0
|
91 |
} {12.34 1 {expected integer but got "12.34"}}
|
sl@0
|
92 |
test obj-3.2 {Tcl_ConvertToType error, "empty string" object} {
|
sl@0
|
93 |
list [testobj newobj 1] [catch {testobj convert 1 int} msg] $msg
|
sl@0
|
94 |
} {{} 1 {expected integer but got ""}}
|
sl@0
|
95 |
|
sl@0
|
96 |
test obj-4.1 {Tcl_NewObj and AllocateFreeObjects} {
|
sl@0
|
97 |
set result ""
|
sl@0
|
98 |
lappend result [testobj freeallvars]
|
sl@0
|
99 |
lappend result [testobj newobj 1]
|
sl@0
|
100 |
lappend result [testobj type 1]
|
sl@0
|
101 |
lappend result [testobj refcount 1]
|
sl@0
|
102 |
} {{} {} string 2}
|
sl@0
|
103 |
|
sl@0
|
104 |
test obj-5.1 {Tcl_FreeObj} {
|
sl@0
|
105 |
set result ""
|
sl@0
|
106 |
lappend result [testintobj set 1 12345]
|
sl@0
|
107 |
lappend result [testobj freeallvars]
|
sl@0
|
108 |
lappend result [catch {testintobj get 1} msg]
|
sl@0
|
109 |
lappend result $msg
|
sl@0
|
110 |
} {12345 {} 1 {variable 1 is unset (NULL)}}
|
sl@0
|
111 |
|
sl@0
|
112 |
test obj-6.1 {Tcl_DuplicateObj, object has internal rep} {
|
sl@0
|
113 |
set result ""
|
sl@0
|
114 |
lappend result [testobj freeallvars]
|
sl@0
|
115 |
lappend result [testintobj set 1 47]
|
sl@0
|
116 |
lappend result [testobj duplicate 1 2]
|
sl@0
|
117 |
lappend result [testintobj get 2]
|
sl@0
|
118 |
lappend result [testobj refcount 1]
|
sl@0
|
119 |
lappend result [testobj refcount 2]
|
sl@0
|
120 |
} {{} 47 47 47 2 3}
|
sl@0
|
121 |
test obj-6.2 {Tcl_DuplicateObj, "empty string" object} {
|
sl@0
|
122 |
set result ""
|
sl@0
|
123 |
lappend result [testobj freeallvars]
|
sl@0
|
124 |
lappend result [testobj newobj 1]
|
sl@0
|
125 |
lappend result [testobj duplicate 1 2]
|
sl@0
|
126 |
lappend result [testintobj get 2]
|
sl@0
|
127 |
lappend result [testobj refcount 1]
|
sl@0
|
128 |
lappend result [testobj refcount 2]
|
sl@0
|
129 |
} {{} {} {} {} 2 3}
|
sl@0
|
130 |
|
sl@0
|
131 |
test obj-7.1 {Tcl_GetString, return existing string rep} {
|
sl@0
|
132 |
set result ""
|
sl@0
|
133 |
lappend result [testintobj set 1 47]
|
sl@0
|
134 |
lappend result [testintobj get2 1]
|
sl@0
|
135 |
} {47 47}
|
sl@0
|
136 |
test obj-7.2 {Tcl_GetString, "empty string" object} {
|
sl@0
|
137 |
set result ""
|
sl@0
|
138 |
lappend result [testobj newobj 1]
|
sl@0
|
139 |
lappend result [teststringobj append 1 abc -1]
|
sl@0
|
140 |
lappend result [teststringobj get2 1]
|
sl@0
|
141 |
} {{} abc abc}
|
sl@0
|
142 |
test obj-7.3 {Tcl_GetString, returns string internal rep (DString)} {
|
sl@0
|
143 |
set result ""
|
sl@0
|
144 |
lappend result [teststringobj set 1 xyz]
|
sl@0
|
145 |
lappend result [teststringobj append 1 abc -1]
|
sl@0
|
146 |
lappend result [teststringobj get2 1]
|
sl@0
|
147 |
} {xyz xyzabc xyzabc}
|
sl@0
|
148 |
test obj-7.4 {Tcl_GetString, recompute string rep from internal rep} {
|
sl@0
|
149 |
set result ""
|
sl@0
|
150 |
lappend result [testintobj set 1 77]
|
sl@0
|
151 |
lappend result [testintobj mult10 1]
|
sl@0
|
152 |
lappend result [teststringobj get2 1]
|
sl@0
|
153 |
} {77 770 770}
|
sl@0
|
154 |
|
sl@0
|
155 |
test obj-8.1 {Tcl_GetStringFromObj, return existing string rep} {
|
sl@0
|
156 |
set result ""
|
sl@0
|
157 |
lappend result [testintobj set 1 47]
|
sl@0
|
158 |
lappend result [testintobj get 1]
|
sl@0
|
159 |
} {47 47}
|
sl@0
|
160 |
test obj-8.2 {Tcl_GetStringFromObj, "empty string" object} {
|
sl@0
|
161 |
set result ""
|
sl@0
|
162 |
lappend result [testobj newobj 1]
|
sl@0
|
163 |
lappend result [teststringobj append 1 abc -1]
|
sl@0
|
164 |
lappend result [teststringobj get 1]
|
sl@0
|
165 |
} {{} abc abc}
|
sl@0
|
166 |
test obj-8.3 {Tcl_GetStringFromObj, returns string internal rep (DString)} {
|
sl@0
|
167 |
set result ""
|
sl@0
|
168 |
lappend result [teststringobj set 1 xyz]
|
sl@0
|
169 |
lappend result [teststringobj append 1 abc -1]
|
sl@0
|
170 |
lappend result [teststringobj get 1]
|
sl@0
|
171 |
} {xyz xyzabc xyzabc}
|
sl@0
|
172 |
test obj-8.4 {Tcl_GetStringFromObj, recompute string rep from internal rep} {
|
sl@0
|
173 |
set result ""
|
sl@0
|
174 |
lappend result [testintobj set 1 77]
|
sl@0
|
175 |
lappend result [testintobj mult10 1]
|
sl@0
|
176 |
lappend result [teststringobj get 1]
|
sl@0
|
177 |
} {77 770 770}
|
sl@0
|
178 |
|
sl@0
|
179 |
test obj-9.1 {Tcl_NewBooleanObj} {
|
sl@0
|
180 |
set result ""
|
sl@0
|
181 |
lappend result [testobj freeallvars]
|
sl@0
|
182 |
lappend result [testbooleanobj set 1 0]
|
sl@0
|
183 |
lappend result [testobj type 1]
|
sl@0
|
184 |
lappend result [testobj refcount 1]
|
sl@0
|
185 |
} {{} 0 boolean 2}
|
sl@0
|
186 |
|
sl@0
|
187 |
test obj-10.1 {Tcl_SetBooleanObj, existing "empty string" object} {
|
sl@0
|
188 |
set result ""
|
sl@0
|
189 |
lappend result [testobj freeallvars]
|
sl@0
|
190 |
lappend result [testobj newobj 1]
|
sl@0
|
191 |
lappend result [testbooleanobj set 1 0] ;# makes existing obj boolean
|
sl@0
|
192 |
lappend result [testobj type 1]
|
sl@0
|
193 |
lappend result [testobj refcount 1]
|
sl@0
|
194 |
} {{} {} 0 boolean 2}
|
sl@0
|
195 |
test obj-10.2 {Tcl_SetBooleanObj, existing non-"empty string" object} {
|
sl@0
|
196 |
set result ""
|
sl@0
|
197 |
lappend result [testobj freeallvars]
|
sl@0
|
198 |
lappend result [testintobj set 1 98765]
|
sl@0
|
199 |
lappend result [testbooleanobj set 1 1] ;# makes existing obj boolean
|
sl@0
|
200 |
lappend result [testobj type 1]
|
sl@0
|
201 |
lappend result [testobj refcount 1]
|
sl@0
|
202 |
} {{} 98765 1 boolean 2}
|
sl@0
|
203 |
|
sl@0
|
204 |
test obj-11.1 {Tcl_GetBooleanFromObj, existing boolean object} {
|
sl@0
|
205 |
set result ""
|
sl@0
|
206 |
lappend result [testbooleanobj set 1 1]
|
sl@0
|
207 |
lappend result [testbooleanobj not 1] ;# gets existing boolean rep
|
sl@0
|
208 |
} {1 0}
|
sl@0
|
209 |
test obj-11.2 {Tcl_GetBooleanFromObj, convert to boolean} {
|
sl@0
|
210 |
set result ""
|
sl@0
|
211 |
lappend result [testintobj set 1 47]
|
sl@0
|
212 |
lappend result [testbooleanobj not 1] ;# must convert to bool
|
sl@0
|
213 |
lappend result [testobj type 1]
|
sl@0
|
214 |
} {47 0 boolean}
|
sl@0
|
215 |
test obj-11.3 {Tcl_GetBooleanFromObj, error converting to boolean} {
|
sl@0
|
216 |
set result ""
|
sl@0
|
217 |
lappend result [teststringobj set 1 abc]
|
sl@0
|
218 |
lappend result [catch {testbooleanobj not 1} msg]
|
sl@0
|
219 |
lappend result $msg
|
sl@0
|
220 |
} {abc 1 {expected boolean value but got "abc"}}
|
sl@0
|
221 |
test obj-11.4 {Tcl_GetBooleanFromObj, error converting from "empty string"} {
|
sl@0
|
222 |
set result ""
|
sl@0
|
223 |
lappend result [testobj newobj 1]
|
sl@0
|
224 |
lappend result [catch {testbooleanobj not 1} msg]
|
sl@0
|
225 |
lappend result $msg
|
sl@0
|
226 |
} {{} 1 {expected boolean value but got ""}}
|
sl@0
|
227 |
test obj-11.5 {Tcl_GetBooleanFromObj, convert hex to boolean} {
|
sl@0
|
228 |
set result ""
|
sl@0
|
229 |
lappend result [teststringobj set 1 0xac]
|
sl@0
|
230 |
lappend result [testbooleanobj not 1]
|
sl@0
|
231 |
lappend result [testobj type 1]
|
sl@0
|
232 |
} {0xac 0 boolean}
|
sl@0
|
233 |
test obj-11.6 {Tcl_GetBooleanFromObj, convert float to boolean} {
|
sl@0
|
234 |
set result ""
|
sl@0
|
235 |
lappend result [teststringobj set 1 5.42]
|
sl@0
|
236 |
lappend result [testbooleanobj not 1]
|
sl@0
|
237 |
lappend result [testobj type 1]
|
sl@0
|
238 |
} {5.42 0 boolean}
|
sl@0
|
239 |
|
sl@0
|
240 |
test obj-12.1 {DupBooleanInternalRep} {
|
sl@0
|
241 |
set result ""
|
sl@0
|
242 |
lappend result [testbooleanobj set 1 1]
|
sl@0
|
243 |
lappend result [testobj duplicate 1 2] ;# uses DupBooleanInternalRep
|
sl@0
|
244 |
lappend result [testbooleanobj get 2]
|
sl@0
|
245 |
} {1 1 1}
|
sl@0
|
246 |
|
sl@0
|
247 |
test obj-13.1 {SetBooleanFromAny, int to boolean special case} {
|
sl@0
|
248 |
set result ""
|
sl@0
|
249 |
lappend result [testintobj set 1 1234]
|
sl@0
|
250 |
lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny
|
sl@0
|
251 |
lappend result [testobj type 1]
|
sl@0
|
252 |
} {1234 0 boolean}
|
sl@0
|
253 |
test obj-13.2 {SetBooleanFromAny, double to boolean special case} {
|
sl@0
|
254 |
set result ""
|
sl@0
|
255 |
lappend result [testdoubleobj set 1 3.14159]
|
sl@0
|
256 |
lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny
|
sl@0
|
257 |
lappend result [testobj type 1]
|
sl@0
|
258 |
} {3.14159 0 boolean}
|
sl@0
|
259 |
test obj-13.3 {SetBooleanFromAny, special case strings representing booleans} {
|
sl@0
|
260 |
set result ""
|
sl@0
|
261 |
foreach s {yes no true false on off} {
|
sl@0
|
262 |
teststringobj set 1 $s
|
sl@0
|
263 |
lappend result [testbooleanobj not 1]
|
sl@0
|
264 |
}
|
sl@0
|
265 |
lappend result [testobj type 1]
|
sl@0
|
266 |
} {0 1 0 1 0 1 boolean}
|
sl@0
|
267 |
test obj-13.4 {SetBooleanFromAny, recompute string rep then parse it} {
|
sl@0
|
268 |
set result ""
|
sl@0
|
269 |
lappend result [testintobj set 1 456]
|
sl@0
|
270 |
lappend result [testintobj div10 1]
|
sl@0
|
271 |
lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny
|
sl@0
|
272 |
lappend result [testobj type 1]
|
sl@0
|
273 |
} {456 45 0 boolean}
|
sl@0
|
274 |
test obj-13.5 {SetBooleanFromAny, error parsing string} {
|
sl@0
|
275 |
set result ""
|
sl@0
|
276 |
lappend result [teststringobj set 1 abc]
|
sl@0
|
277 |
lappend result [catch {testbooleanobj not 1} msg]
|
sl@0
|
278 |
lappend result $msg
|
sl@0
|
279 |
} {abc 1 {expected boolean value but got "abc"}}
|
sl@0
|
280 |
test obj-13.6 {SetBooleanFromAny, error parsing string} {
|
sl@0
|
281 |
set result ""
|
sl@0
|
282 |
lappend result [teststringobj set 1 x1.0]
|
sl@0
|
283 |
lappend result [catch {testbooleanobj not 1} msg]
|
sl@0
|
284 |
lappend result $msg
|
sl@0
|
285 |
} {x1.0 1 {expected boolean value but got "x1.0"}}
|
sl@0
|
286 |
test obj-13.7 {SetBooleanFromAny, error converting from "empty string"} {
|
sl@0
|
287 |
set result ""
|
sl@0
|
288 |
lappend result [testobj newobj 1]
|
sl@0
|
289 |
lappend result [catch {testbooleanobj not 1} msg]
|
sl@0
|
290 |
lappend result $msg
|
sl@0
|
291 |
} {{} 1 {expected boolean value but got ""}}
|
sl@0
|
292 |
test obj-13.8 {SetBooleanFromAny, unicode strings} {
|
sl@0
|
293 |
set result ""
|
sl@0
|
294 |
lappend result [teststringobj set 1 1\u7777]
|
sl@0
|
295 |
lappend result [catch {testbooleanobj not 1} msg]
|
sl@0
|
296 |
lappend result $msg
|
sl@0
|
297 |
} "1\u7777 1 {expected boolean value but got \"1\u7777\"}"
|
sl@0
|
298 |
|
sl@0
|
299 |
test obj-14.1 {UpdateStringOfBoolean} {
|
sl@0
|
300 |
set result ""
|
sl@0
|
301 |
lappend result [testbooleanobj set 1 0]
|
sl@0
|
302 |
lappend result [testbooleanobj not 1]
|
sl@0
|
303 |
lappend result [testbooleanobj get 1] ;# must update string rep
|
sl@0
|
304 |
} {0 1 1}
|
sl@0
|
305 |
|
sl@0
|
306 |
test obj-15.1 {Tcl_NewDoubleObj} {
|
sl@0
|
307 |
set result ""
|
sl@0
|
308 |
lappend result [testobj freeallvars]
|
sl@0
|
309 |
lappend result [testdoubleobj set 1 3.1459]
|
sl@0
|
310 |
lappend result [testobj type 1]
|
sl@0
|
311 |
lappend result [testobj refcount 1]
|
sl@0
|
312 |
} {{} 3.1459 double 2}
|
sl@0
|
313 |
|
sl@0
|
314 |
test obj-16.1 {Tcl_SetDoubleObj, existing "empty string" object} {
|
sl@0
|
315 |
set result ""
|
sl@0
|
316 |
lappend result [testobj freeallvars]
|
sl@0
|
317 |
lappend result [testobj newobj 1]
|
sl@0
|
318 |
lappend result [testdoubleobj set 1 0.123] ;# makes existing obj boolean
|
sl@0
|
319 |
lappend result [testobj type 1]
|
sl@0
|
320 |
lappend result [testobj refcount 1]
|
sl@0
|
321 |
} {{} {} 0.123 double 2}
|
sl@0
|
322 |
test obj-16.2 {Tcl_SetDoubleObj, existing non-"empty string" object} {
|
sl@0
|
323 |
set result ""
|
sl@0
|
324 |
lappend result [testobj freeallvars]
|
sl@0
|
325 |
lappend result [testintobj set 1 98765]
|
sl@0
|
326 |
lappend result [testdoubleobj set 1 27.56] ;# makes existing obj double
|
sl@0
|
327 |
lappend result [testobj type 1]
|
sl@0
|
328 |
lappend result [testobj refcount 1]
|
sl@0
|
329 |
} {{} 98765 27.56 double 2}
|
sl@0
|
330 |
|
sl@0
|
331 |
test obj-17.1 {Tcl_GetDoubleFromObj, existing double object} {
|
sl@0
|
332 |
set result ""
|
sl@0
|
333 |
lappend result [testdoubleobj set 1 16.1]
|
sl@0
|
334 |
lappend result [testdoubleobj mult10 1] ;# gets existing double rep
|
sl@0
|
335 |
} {16.1 161.0}
|
sl@0
|
336 |
test obj-17.2 {Tcl_GetDoubleFromObj, convert to double} {
|
sl@0
|
337 |
set result ""
|
sl@0
|
338 |
lappend result [testintobj set 1 477]
|
sl@0
|
339 |
lappend result [testdoubleobj div10 1] ;# must convert to bool
|
sl@0
|
340 |
lappend result [testobj type 1]
|
sl@0
|
341 |
} {477 47.7 double}
|
sl@0
|
342 |
test obj-17.3 {Tcl_GetDoubleFromObj, error converting to double} {
|
sl@0
|
343 |
set result ""
|
sl@0
|
344 |
lappend result [teststringobj set 1 abc]
|
sl@0
|
345 |
lappend result [catch {testdoubleobj mult10 1} msg]
|
sl@0
|
346 |
lappend result $msg
|
sl@0
|
347 |
} {abc 1 {expected floating-point number but got "abc"}}
|
sl@0
|
348 |
test obj-17.4 {Tcl_GetDoubleFromObj, error converting from "empty string"} {
|
sl@0
|
349 |
set result ""
|
sl@0
|
350 |
lappend result [testobj newobj 1]
|
sl@0
|
351 |
lappend result [catch {testdoubleobj div10 1} msg]
|
sl@0
|
352 |
lappend result $msg
|
sl@0
|
353 |
} {{} 1 {expected floating-point number but got ""}}
|
sl@0
|
354 |
|
sl@0
|
355 |
test obj-18.1 {DupDoubleInternalRep} {
|
sl@0
|
356 |
set result ""
|
sl@0
|
357 |
lappend result [testdoubleobj set 1 17.1]
|
sl@0
|
358 |
lappend result [testobj duplicate 1 2] ;# uses DupDoubleInternalRep
|
sl@0
|
359 |
lappend result [testdoubleobj get 2]
|
sl@0
|
360 |
} {17.1 17.1 17.1}
|
sl@0
|
361 |
|
sl@0
|
362 |
test obj-19.1 {SetDoubleFromAny, int to double special case} {
|
sl@0
|
363 |
set result ""
|
sl@0
|
364 |
lappend result [testintobj set 1 1234]
|
sl@0
|
365 |
lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny
|
sl@0
|
366 |
lappend result [testobj type 1]
|
sl@0
|
367 |
} {1234 12340.0 double}
|
sl@0
|
368 |
test obj-19.2 {SetDoubleFromAny, boolean to double special case} {
|
sl@0
|
369 |
set result ""
|
sl@0
|
370 |
lappend result [testbooleanobj set 1 1]
|
sl@0
|
371 |
lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny
|
sl@0
|
372 |
lappend result [testobj type 1]
|
sl@0
|
373 |
} {1 10.0 double}
|
sl@0
|
374 |
test obj-19.3 {SetDoubleFromAny, recompute string rep then parse it} {
|
sl@0
|
375 |
set result ""
|
sl@0
|
376 |
lappend result [testintobj set 1 456]
|
sl@0
|
377 |
lappend result [testintobj div10 1]
|
sl@0
|
378 |
lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny
|
sl@0
|
379 |
lappend result [testobj type 1]
|
sl@0
|
380 |
} {456 45 450.0 double}
|
sl@0
|
381 |
test obj-19.4 {SetDoubleFromAny, error parsing string} {
|
sl@0
|
382 |
set result ""
|
sl@0
|
383 |
lappend result [teststringobj set 1 abc]
|
sl@0
|
384 |
lappend result [catch {testdoubleobj mult10 1} msg]
|
sl@0
|
385 |
lappend result $msg
|
sl@0
|
386 |
} {abc 1 {expected floating-point number but got "abc"}}
|
sl@0
|
387 |
test obj-19.5 {SetDoubleFromAny, error parsing string} {
|
sl@0
|
388 |
set result ""
|
sl@0
|
389 |
lappend result [teststringobj set 1 x1.0]
|
sl@0
|
390 |
lappend result [catch {testdoubleobj mult10 1} msg]
|
sl@0
|
391 |
lappend result $msg
|
sl@0
|
392 |
} {x1.0 1 {expected floating-point number but got "x1.0"}}
|
sl@0
|
393 |
test obj-19.6 {SetDoubleFromAny, error converting from "empty string"} {
|
sl@0
|
394 |
set result ""
|
sl@0
|
395 |
lappend result [testobj newobj 1]
|
sl@0
|
396 |
lappend result [catch {testdoubleobj div10 1} msg]
|
sl@0
|
397 |
lappend result $msg
|
sl@0
|
398 |
} {{} 1 {expected floating-point number but got ""}}
|
sl@0
|
399 |
|
sl@0
|
400 |
test obj-20.1 {UpdateStringOfDouble} {
|
sl@0
|
401 |
set result ""
|
sl@0
|
402 |
lappend result [testdoubleobj set 1 3.14159]
|
sl@0
|
403 |
lappend result [testdoubleobj mult10 1]
|
sl@0
|
404 |
lappend result [testdoubleobj get 1] ;# must update string rep
|
sl@0
|
405 |
} {3.14159 31.4159 31.4159}
|
sl@0
|
406 |
|
sl@0
|
407 |
test obj-21.1 {Tcl_NewIntObj} {
|
sl@0
|
408 |
set result ""
|
sl@0
|
409 |
lappend result [testobj freeallvars]
|
sl@0
|
410 |
lappend result [testintobj set 1 55]
|
sl@0
|
411 |
lappend result [testobj type 1]
|
sl@0
|
412 |
lappend result [testobj refcount 1]
|
sl@0
|
413 |
} {{} 55 int 2}
|
sl@0
|
414 |
|
sl@0
|
415 |
test obj-22.1 {Tcl_SetIntObj, existing "empty string" object} {
|
sl@0
|
416 |
set result ""
|
sl@0
|
417 |
lappend result [testobj freeallvars]
|
sl@0
|
418 |
lappend result [testobj newobj 1]
|
sl@0
|
419 |
lappend result [testintobj set 1 77] ;# makes existing obj int
|
sl@0
|
420 |
lappend result [testobj type 1]
|
sl@0
|
421 |
lappend result [testobj refcount 1]
|
sl@0
|
422 |
} {{} {} 77 int 2}
|
sl@0
|
423 |
test obj-22.2 {Tcl_SetIntObj, existing non-"empty string" object} {
|
sl@0
|
424 |
set result ""
|
sl@0
|
425 |
lappend result [testobj freeallvars]
|
sl@0
|
426 |
lappend result [testdoubleobj set 1 12.34]
|
sl@0
|
427 |
lappend result [testintobj set 1 77] ;# makes existing obj int
|
sl@0
|
428 |
lappend result [testobj type 1]
|
sl@0
|
429 |
lappend result [testobj refcount 1]
|
sl@0
|
430 |
} {{} 12.34 77 int 2}
|
sl@0
|
431 |
|
sl@0
|
432 |
test obj-23.1 {Tcl_GetIntFromObj, existing int object} {
|
sl@0
|
433 |
set result ""
|
sl@0
|
434 |
lappend result [testintobj set 1 22]
|
sl@0
|
435 |
lappend result [testintobj mult10 1] ;# gets existing int rep
|
sl@0
|
436 |
} {22 220}
|
sl@0
|
437 |
test obj-23.2 {Tcl_GetIntFromObj, convert to int} {
|
sl@0
|
438 |
set result ""
|
sl@0
|
439 |
lappend result [testintobj set 1 477]
|
sl@0
|
440 |
lappend result [testintobj div10 1] ;# must convert to bool
|
sl@0
|
441 |
lappend result [testobj type 1]
|
sl@0
|
442 |
} {477 47 int}
|
sl@0
|
443 |
test obj-23.3 {Tcl_GetIntFromObj, error converting to int} {
|
sl@0
|
444 |
set result ""
|
sl@0
|
445 |
lappend result [teststringobj set 1 abc]
|
sl@0
|
446 |
lappend result [catch {testintobj mult10 1} msg]
|
sl@0
|
447 |
lappend result $msg
|
sl@0
|
448 |
} {abc 1 {expected integer but got "abc"}}
|
sl@0
|
449 |
test obj-23.4 {Tcl_GetIntFromObj, error converting from "empty string"} {
|
sl@0
|
450 |
set result ""
|
sl@0
|
451 |
lappend result [testobj newobj 1]
|
sl@0
|
452 |
lappend result [catch {testintobj div10 1} msg]
|
sl@0
|
453 |
lappend result $msg
|
sl@0
|
454 |
} {{} 1 {expected integer but got ""}}
|
sl@0
|
455 |
test obj-23.5 {Tcl_GetIntFromObj, integer too large to represent as non-long error} {nonPortable} {
|
sl@0
|
456 |
set result ""
|
sl@0
|
457 |
lappend result [testobj newobj 1]
|
sl@0
|
458 |
lappend result [testintobj inttoobigtest 1]
|
sl@0
|
459 |
} {{} 1}
|
sl@0
|
460 |
|
sl@0
|
461 |
test obj-24.1 {DupIntInternalRep} {
|
sl@0
|
462 |
set result ""
|
sl@0
|
463 |
lappend result [testintobj set 1 23]
|
sl@0
|
464 |
lappend result [testobj duplicate 1 2] ;# uses DupIntInternalRep
|
sl@0
|
465 |
lappend result [testintobj get 2]
|
sl@0
|
466 |
} {23 23 23}
|
sl@0
|
467 |
|
sl@0
|
468 |
test obj-25.1 {SetIntFromAny, int to int special case} {
|
sl@0
|
469 |
set result ""
|
sl@0
|
470 |
lappend result [testintobj set 1 1234]
|
sl@0
|
471 |
lappend result [testintobj mult10 1] ;# converts with SetIntFromAny
|
sl@0
|
472 |
lappend result [testobj type 1]
|
sl@0
|
473 |
} {1234 12340 int}
|
sl@0
|
474 |
test obj-25.2 {SetIntFromAny, boolean to int special case} {
|
sl@0
|
475 |
set result ""
|
sl@0
|
476 |
lappend result [testbooleanobj set 1 1]
|
sl@0
|
477 |
lappend result [testintobj mult10 1] ;# converts with SetIntFromAny
|
sl@0
|
478 |
lappend result [testobj type 1]
|
sl@0
|
479 |
} {1 10 int}
|
sl@0
|
480 |
test obj-25.3 {SetIntFromAny, recompute string rep then parse it} {
|
sl@0
|
481 |
set result ""
|
sl@0
|
482 |
lappend result [testintobj set 1 456]
|
sl@0
|
483 |
lappend result [testintobj div10 1]
|
sl@0
|
484 |
lappend result [testintobj mult10 1] ;# converts with SetIntFromAny
|
sl@0
|
485 |
lappend result [testobj type 1]
|
sl@0
|
486 |
} {456 45 450 int}
|
sl@0
|
487 |
test obj-25.4 {SetIntFromAny, error parsing string} {
|
sl@0
|
488 |
set result ""
|
sl@0
|
489 |
lappend result [teststringobj set 1 abc]
|
sl@0
|
490 |
lappend result [catch {testintobj mult10 1} msg]
|
sl@0
|
491 |
lappend result $msg
|
sl@0
|
492 |
} {abc 1 {expected integer but got "abc"}}
|
sl@0
|
493 |
test obj-25.5 {SetIntFromAny, error parsing string} {
|
sl@0
|
494 |
set result ""
|
sl@0
|
495 |
lappend result [teststringobj set 1 x17]
|
sl@0
|
496 |
lappend result [catch {testintobj mult10 1} msg]
|
sl@0
|
497 |
lappend result $msg
|
sl@0
|
498 |
} {x17 1 {expected integer but got "x17"}}
|
sl@0
|
499 |
test obj-25.6 {SetIntFromAny, integer too large} {nonPortable} {
|
sl@0
|
500 |
set result ""
|
sl@0
|
501 |
lappend result [teststringobj set 1 123456789012345678901]
|
sl@0
|
502 |
lappend result [catch {testintobj mult10 1} msg]
|
sl@0
|
503 |
lappend result $msg
|
sl@0
|
504 |
} {123456789012345678901 1 {integer value too large to represent}}
|
sl@0
|
505 |
test obj-25.7 {SetIntFromAny, error converting from "empty string"} {
|
sl@0
|
506 |
set result ""
|
sl@0
|
507 |
lappend result [testobj newobj 1]
|
sl@0
|
508 |
lappend result [catch {testintobj div10 1} msg]
|
sl@0
|
509 |
lappend result $msg
|
sl@0
|
510 |
} {{} 1 {expected integer but got ""}}
|
sl@0
|
511 |
|
sl@0
|
512 |
test obj-26.1 {UpdateStringOfInt} {
|
sl@0
|
513 |
set result ""
|
sl@0
|
514 |
lappend result [testintobj set 1 512]
|
sl@0
|
515 |
lappend result [testintobj mult10 1]
|
sl@0
|
516 |
lappend result [testintobj get 1] ;# must update string rep
|
sl@0
|
517 |
} {512 5120 5120}
|
sl@0
|
518 |
|
sl@0
|
519 |
test obj-27.1 {Tcl_NewLongObj} {
|
sl@0
|
520 |
set result ""
|
sl@0
|
521 |
lappend result [testobj freeallvars]
|
sl@0
|
522 |
testintobj setmaxlong 1
|
sl@0
|
523 |
lappend result [testintobj ismaxlong 1]
|
sl@0
|
524 |
lappend result [testobj type 1]
|
sl@0
|
525 |
lappend result [testobj refcount 1]
|
sl@0
|
526 |
} {{} 1 int 1}
|
sl@0
|
527 |
|
sl@0
|
528 |
test obj-28.1 {Tcl_SetLongObj, existing "empty string" object} {
|
sl@0
|
529 |
set result ""
|
sl@0
|
530 |
lappend result [testobj freeallvars]
|
sl@0
|
531 |
lappend result [testobj newobj 1]
|
sl@0
|
532 |
lappend result [testintobj setlong 1 77] ;# makes existing obj long int
|
sl@0
|
533 |
lappend result [testobj type 1]
|
sl@0
|
534 |
lappend result [testobj refcount 1]
|
sl@0
|
535 |
} {{} {} 77 int 2}
|
sl@0
|
536 |
test obj-28.2 {Tcl_SetLongObj, existing non-"empty string" object} {
|
sl@0
|
537 |
set result ""
|
sl@0
|
538 |
lappend result [testobj freeallvars]
|
sl@0
|
539 |
lappend result [testdoubleobj set 1 12.34]
|
sl@0
|
540 |
lappend result [testintobj setlong 1 77] ;# makes existing obj long int
|
sl@0
|
541 |
lappend result [testobj type 1]
|
sl@0
|
542 |
lappend result [testobj refcount 1]
|
sl@0
|
543 |
} {{} 12.34 77 int 2}
|
sl@0
|
544 |
|
sl@0
|
545 |
test obj-29.1 {Tcl_GetLongFromObj, existing long integer object} {
|
sl@0
|
546 |
set result ""
|
sl@0
|
547 |
lappend result [testintobj setlong 1 22]
|
sl@0
|
548 |
lappend result [testintobj mult10 1] ;# gets existing long int rep
|
sl@0
|
549 |
} {22 220}
|
sl@0
|
550 |
test obj-29.2 {Tcl_GetLongFromObj, convert to long} {
|
sl@0
|
551 |
set result ""
|
sl@0
|
552 |
lappend result [testintobj setlong 1 477]
|
sl@0
|
553 |
lappend result [testintobj div10 1] ;# must convert to bool
|
sl@0
|
554 |
lappend result [testobj type 1]
|
sl@0
|
555 |
} {477 47 int}
|
sl@0
|
556 |
test obj-29.3 {Tcl_GetLongFromObj, error converting to long integer} {
|
sl@0
|
557 |
set result ""
|
sl@0
|
558 |
lappend result [teststringobj set 1 abc]
|
sl@0
|
559 |
lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int
|
sl@0
|
560 |
lappend result $msg
|
sl@0
|
561 |
} {abc 1 {expected integer but got "abc"}}
|
sl@0
|
562 |
test obj-29.4 {Tcl_GetLongFromObj, error converting from "empty string"} {
|
sl@0
|
563 |
set result ""
|
sl@0
|
564 |
lappend result [testobj newobj 1]
|
sl@0
|
565 |
lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int
|
sl@0
|
566 |
lappend result $msg
|
sl@0
|
567 |
} {{} 1 {expected integer but got ""}}
|
sl@0
|
568 |
|
sl@0
|
569 |
test obj-30.1 {Ref counting and object deletion, simple types} {
|
sl@0
|
570 |
set result ""
|
sl@0
|
571 |
lappend result [testobj freeallvars]
|
sl@0
|
572 |
lappend result [testintobj set 1 1024]
|
sl@0
|
573 |
lappend result [testobj assign 1 2] ;# vars 1 and 2 share the int obj
|
sl@0
|
574 |
lappend result [testobj type 2]
|
sl@0
|
575 |
lappend result [testobj refcount 1]
|
sl@0
|
576 |
lappend result [testobj refcount 2]
|
sl@0
|
577 |
lappend result [testbooleanobj set 2 0] ;# must copy on write, now 2 objs
|
sl@0
|
578 |
lappend result [testobj type 2]
|
sl@0
|
579 |
lappend result [testobj refcount 1]
|
sl@0
|
580 |
lappend result [testobj refcount 2]
|
sl@0
|
581 |
} {{} 1024 1024 int 4 4 0 boolean 3 2}
|
sl@0
|
582 |
|
sl@0
|
583 |
|
sl@0
|
584 |
test obj-31.1 {regenerate string rep of "end"} {
|
sl@0
|
585 |
testobj freeallvars
|
sl@0
|
586 |
teststringobj set 1 end
|
sl@0
|
587 |
testobj convert 1 end-offset
|
sl@0
|
588 |
testobj invalidateStringRep 1
|
sl@0
|
589 |
} end
|
sl@0
|
590 |
|
sl@0
|
591 |
test obj-31.2 {regenerate string rep of "end-1"} {
|
sl@0
|
592 |
testobj freeallvars
|
sl@0
|
593 |
teststringobj set 1 end-0x1
|
sl@0
|
594 |
testobj convert 1 end-offset
|
sl@0
|
595 |
testobj invalidateStringRep 1
|
sl@0
|
596 |
} end-1
|
sl@0
|
597 |
|
sl@0
|
598 |
test obj-31.3 {regenerate string rep of "end--1"} {
|
sl@0
|
599 |
testobj freeallvars
|
sl@0
|
600 |
teststringobj set 1 end--0x1
|
sl@0
|
601 |
testobj convert 1 end-offset
|
sl@0
|
602 |
testobj invalidateStringRep 1
|
sl@0
|
603 |
} end--1
|
sl@0
|
604 |
|
sl@0
|
605 |
test obj-31.4 {regenerate string rep of "end-bigInteger"} {
|
sl@0
|
606 |
testobj freeallvars
|
sl@0
|
607 |
teststringobj set 1 end-0x7fffffff
|
sl@0
|
608 |
testobj convert 1 end-offset
|
sl@0
|
609 |
testobj invalidateStringRep 1
|
sl@0
|
610 |
} end-2147483647
|
sl@0
|
611 |
|
sl@0
|
612 |
test obj-31.5 {regenerate string rep of "end--bigInteger"} {
|
sl@0
|
613 |
testobj freeallvars
|
sl@0
|
614 |
teststringobj set 1 end--0x7fffffff
|
sl@0
|
615 |
testobj convert 1 end-offset
|
sl@0
|
616 |
testobj invalidateStringRep 1
|
sl@0
|
617 |
} end--2147483647
|
sl@0
|
618 |
|
sl@0
|
619 |
|
sl@0
|
620 |
test obj-31.6 {regenerate string rep of "end--bigInteger"} {nonPortable} {
|
sl@0
|
621 |
testobj freeallvars
|
sl@0
|
622 |
teststringobj set 1 end--0x80000000
|
sl@0
|
623 |
testobj convert 1 end-offset
|
sl@0
|
624 |
testobj invalidateStringRep 1
|
sl@0
|
625 |
} end--2147483648
|
sl@0
|
626 |
|
sl@0
|
627 |
test obj-32.1 {integer overflow on input} {32bit wideBiggerThanInt} {
|
sl@0
|
628 |
set x 0x8000; append x 0000
|
sl@0
|
629 |
list [string is integer $x] [expr { wide($x) }]
|
sl@0
|
630 |
} {1 2147483648}
|
sl@0
|
631 |
|
sl@0
|
632 |
test obj-32.2 {integer overflow on input} {32bit wideBiggerThanInt} {
|
sl@0
|
633 |
set x 0xffff; append x ffff
|
sl@0
|
634 |
list [string is integer $x] [expr { wide($x) }]
|
sl@0
|
635 |
} {1 4294967295}
|
sl@0
|
636 |
|
sl@0
|
637 |
test obj-32.3 {integer overflow on input} {32bit wideBiggerThanInt} {
|
sl@0
|
638 |
set x 0x10000; append x 0000
|
sl@0
|
639 |
list [string is integer $x] [expr { wide($x) }]
|
sl@0
|
640 |
} {0 4294967296}
|
sl@0
|
641 |
|
sl@0
|
642 |
test obj-32.4 {integer overflow on input} {32bit wideBiggerThanInt} {
|
sl@0
|
643 |
set x -0x8000; append x 0000
|
sl@0
|
644 |
list [string is integer $x] [expr { wide($x) }]
|
sl@0
|
645 |
} {1 -2147483648}
|
sl@0
|
646 |
|
sl@0
|
647 |
test obj-32.5 {integer overflow on input} {32bit wideBiggerThanInt} {
|
sl@0
|
648 |
set x -0x8000; append x 0001
|
sl@0
|
649 |
list [string is integer $x] [expr { wide($x) }]
|
sl@0
|
650 |
} {1 -2147483649}
|
sl@0
|
651 |
|
sl@0
|
652 |
test obj-32.6 {integer overflow on input} {32bit wideBiggerThanInt} {
|
sl@0
|
653 |
set x -0xffff; append x ffff
|
sl@0
|
654 |
list [string is integer $x] [expr { wide($x) }]
|
sl@0
|
655 |
} {1 -4294967295}
|
sl@0
|
656 |
|
sl@0
|
657 |
test obj-32.7 {integer overflow on input} {32bit wideBiggerThanInt} {
|
sl@0
|
658 |
set x -0x10000; append x 0000
|
sl@0
|
659 |
list [string is integer $x] [expr { wide($x) }]
|
sl@0
|
660 |
} {0 -4294967296}
|
sl@0
|
661 |
|
sl@0
|
662 |
testobj freeallvars
|
sl@0
|
663 |
|
sl@0
|
664 |
# cleanup
|
sl@0
|
665 |
::tcltest::cleanupTests
|
sl@0
|
666 |
return
|
sl@0
|
667 |
|
sl@0
|
668 |
# Local Variables:
|
sl@0
|
669 |
# mode: tcl
|
sl@0
|
670 |
# End:
|