os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/obj.test
author sl@SLION-WIN7.fritz.box
Fri, 15 Jun 2012 03:10:57 +0200
changeset 0 bde4ae8d615e
permissions -rw-r--r--
First public contribution.
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: