obj.test

来自「tcl是工具命令语言」· TEST 代码 · 共 605 行 · 第 1/2 页

# Functionality covered: this file contains a collection of tests for the
# procedures in tclObj.c that implement Tcl's basic type support and the
# type managers for the types boolean, double, and integer.
#
# Sourcing this file into Tcl runs the tests and generates output for
# errors. No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: obj.test,v 1.7 2002/04/26 08:43:38 dkf Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

if {[info commands testobj] == {}} {
    puts "This application hasn't been compiled with the \"testobj\""
    puts "command, so I can't test the Tcl type and object support."
    ::tcltest::cleanupTests
    return
}

test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} {
    set r 1
    foreach {t} {
	{array search} 
	boolean
	bytearray
	bytecode
	double
	end-offset
	index
	int
	list
	nsName
	procbody
	string
    } {
        set first [string first $t [testobj types]]
        set r [expr {$r && ($first != -1)}]
    }
    set result $r
} {1}

test obj-2.1 {Tcl_GetObjType error} {
    list [testintobj set 1 0] [catch {testobj convert 1 foo} msg] $msg
} {0 1 {no type foo found}}
test obj-2.2 {Tcl_GetObjType and Tcl_ConvertToType} {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testintobj set 1 12]
    lappend result [testobj convert 1 double]
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} 12 12 double 3}

test obj-3.1 {Tcl_ConvertToType error} {
    list [testdoubleobj set 1 12.34] [catch {testobj convert 1 int} msg] $msg
} {12.34 1 {expected integer but got "12.34"}}
test obj-3.2 {Tcl_ConvertToType error, "empty string" object} {
    list [testobj newobj 1] [catch {testobj convert 1 int} msg] $msg
} {{} 1 {expected integer but got ""}}

test obj-4.1 {Tcl_NewObj and AllocateFreeObjects} {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testobj newobj 1]
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} {} string 2}

test obj-5.1 {Tcl_FreeObj} {
    set result ""
    lappend result [testintobj set 1 12345]
    lappend result [testobj freeallvars]
    lappend result [catch {testintobj get 1} msg]
    lappend result $msg
} {12345 {} 1 {variable 1 is unset (NULL)}}

test obj-6.1 {Tcl_DuplicateObj, object has internal rep} {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testintobj set 1 47]
    lappend result [testobj duplicate 1 2]    
    lappend result [testintobj get 2]
    lappend result [testobj refcount 1]
    lappend result [testobj refcount 2]
} {{} 47 47 47 2 3}
test obj-6.2 {Tcl_DuplicateObj, "empty string" object} {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testobj newobj 1]
    lappend result [testobj duplicate 1 2]    
    lappend result [testintobj get 2]
    lappend result [testobj refcount 1]
    lappend result [testobj refcount 2]
} {{} {} {} {} 2 3}

test obj-7.1 {Tcl_GetString, return existing string rep} {
    set result ""
    lappend result [testintobj set 1 47]
    lappend result [testintobj get2 1]
} {47 47}
test obj-7.2 {Tcl_GetString, "empty string" object} {
    set result ""
    lappend result [testobj newobj 1]
    lappend result [teststringobj append 1 abc -1]
    lappend result [teststringobj get2 1]
} {{} abc abc}
test obj-7.3 {Tcl_GetString, returns string internal rep (DString)} {
    set result ""
    lappend result [teststringobj set 1 xyz]
    lappend result [teststringobj append 1 abc -1]
    lappend result [teststringobj get2 1]
} {xyz xyzabc xyzabc}
test obj-7.4 {Tcl_GetString, recompute string rep from internal rep} {
    set result ""
    lappend result [testintobj set 1 77]
    lappend result [testintobj mult10 1]
    lappend result [teststringobj get2 1]
} {77 770 770}

test obj-8.1 {Tcl_GetStringFromObj, return existing string rep} {
    set result ""
    lappend result [testintobj set 1 47]
    lappend result [testintobj get 1]
} {47 47}
test obj-8.2 {Tcl_GetStringFromObj, "empty string" object} {
    set result ""
    lappend result [testobj newobj 1]
    lappend result [teststringobj append 1 abc -1]
    lappend result [teststringobj get 1]
} {{} abc abc}
test obj-8.3 {Tcl_GetStringFromObj, returns string internal rep (DString)} {
    set result ""
    lappend result [teststringobj set 1 xyz]
    lappend result [teststringobj append 1 abc -1]
    lappend result [teststringobj get 1]
} {xyz xyzabc xyzabc}
test obj-8.4 {Tcl_GetStringFromObj, recompute string rep from internal rep} {
    set result ""
    lappend result [testintobj set 1 77]
    lappend result [testintobj mult10 1]
    lappend result [teststringobj get 1]
} {77 770 770}

test obj-9.1 {Tcl_NewBooleanObj} {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testbooleanobj set 1 0]
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} 0 boolean 2}

test obj-10.1 {Tcl_SetBooleanObj, existing "empty string" object} {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testobj newobj 1]
    lappend result [testbooleanobj set 1 0]  ;# makes existing obj boolean
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} {} 0 boolean 2}
test obj-10.2 {Tcl_SetBooleanObj, existing non-"empty string" object} {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testintobj set 1 98765]
    lappend result [testbooleanobj set 1 1]  ;# makes existing obj boolean
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} 98765 1 boolean 2}

test obj-11.1 {Tcl_GetBooleanFromObj, existing boolean object} {
    set result ""
    lappend result [testbooleanobj set 1 1]
    lappend result [testbooleanobj not 1]    ;# gets existing boolean rep
} {1 0}
test obj-11.2 {Tcl_GetBooleanFromObj, convert to boolean} {
    set result ""
    lappend result [testintobj set 1 47]
    lappend result [testbooleanobj not 1]    ;# must convert to bool
    lappend result [testobj type 1]
} {47 0 boolean}
test obj-11.3 {Tcl_GetBooleanFromObj, error converting to boolean} {
    set result ""
    lappend result [teststringobj set 1 abc]
    lappend result [catch {testbooleanobj not 1} msg]
    lappend result $msg
} {abc 1 {expected boolean value but got "abc"}}
test obj-11.4 {Tcl_GetBooleanFromObj, error converting from "empty string"} {
    set result ""
    lappend result [testobj newobj 1]
    lappend result [catch {testbooleanobj not 1} msg]
    lappend result $msg
} {{} 1 {expected boolean value but got ""}}
test obj-11.5 {Tcl_GetBooleanFromObj, convert hex to boolean} {
    set result ""
    lappend result [teststringobj set 1 0xac]
    lappend result [testbooleanobj not 1]
    lappend result [testobj type 1]
} {0xac 0 boolean}
test obj-11.6 {Tcl_GetBooleanFromObj, convert float to boolean} {
    set result ""
    lappend result [teststringobj set 1 5.42]
    lappend result [testbooleanobj not 1]
    lappend result [testobj type 1]
} {5.42 0 boolean}

test obj-12.1 {DupBooleanInternalRep} {
    set result ""
    lappend result [testbooleanobj set 1 1]
    lappend result [testobj duplicate 1 2]   ;# uses DupBooleanInternalRep
    lappend result [testbooleanobj get 2]
} {1 1 1}

test obj-13.1 {SetBooleanFromAny, int to boolean special case} {
    set result ""
    lappend result [testintobj set 1 1234]
    lappend result [testbooleanobj not 1]    ;# converts with SetBooleanFromAny
    lappend result [testobj type 1]
} {1234 0 boolean}
test obj-13.2 {SetBooleanFromAny, double to boolean special case} {
    set result ""
    lappend result [testdoubleobj set 1 3.14159]
    lappend result [testbooleanobj not 1]    ;# converts with SetBooleanFromAny
    lappend result [testobj type 1]
} {3.14159 0 boolean}
test obj-13.3 {SetBooleanFromAny, special case strings representing booleans} {
    set result ""
    foreach s {yes no true false on off} {
        teststringobj set 1 $s
        lappend result [testbooleanobj not 1]
    }
    lappend result [testobj type 1]
} {0 1 0 1 0 1 boolean}
test obj-13.4 {SetBooleanFromAny, recompute string rep then parse it} {
    set result ""
    lappend result [testintobj set 1 456]
    lappend result [testintobj div10 1]
    lappend result [testbooleanobj not 1]    ;# converts with SetBooleanFromAny
    lappend result [testobj type 1]
} {456 45 0 boolean}
test obj-13.5 {SetBooleanFromAny, error parsing string} {
    set result ""
    lappend result [teststringobj set 1 abc]
    lappend result [catch {testbooleanobj not 1} msg]
    lappend result $msg
} {abc 1 {expected boolean value but got "abc"}}
test obj-13.6 {SetBooleanFromAny, error parsing string} {
    set result ""
    lappend result [teststringobj set 1 x1.0]
    lappend result [catch {testbooleanobj not 1} msg]
    lappend result $msg
} {x1.0 1 {expected boolean value but got "x1.0"}}
test obj-13.7 {SetBooleanFromAny, error converting from "empty string"} {
    set result ""
    lappend result [testobj newobj 1]
    lappend result [catch {testbooleanobj not 1} msg]
    lappend result $msg
} {{} 1 {expected boolean value but got ""}}
test obj-13.8 {SetBooleanFromAny, unicode strings} {
    set result ""
    lappend result [teststringobj set 1 1\u7777]
    lappend result [catch {testbooleanobj not 1} msg]
    lappend result $msg
} "1\u7777 1 {expected boolean value but got \"1\u7777\"}"

test obj-14.1 {UpdateStringOfBoolean} {
    set result ""
    lappend result [testbooleanobj set 1 0]
    lappend result [testbooleanobj not 1]
    lappend result [testbooleanobj get 1]    ;# must update string rep
} {0 1 1}

test obj-15.1 {Tcl_NewDoubleObj} {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testdoubleobj set 1 3.1459]
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} 3.1459 double 2}

test obj-16.1 {Tcl_SetDoubleObj, existing "empty string" object} {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testobj newobj 1]
    lappend result [testdoubleobj set 1 0.123]  ;# makes existing obj boolean
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} {} 0.123 double 2}
test obj-16.2 {Tcl_SetDoubleObj, existing non-"empty string" object} {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testintobj set 1 98765]
    lappend result [testdoubleobj set 1 27.56]  ;# makes existing obj double
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} 98765 27.56 double 2}