execute.test

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

# INST_UPLUS is partially tested:
test execute-3.49 {TclExecuteByteCode, INST_UPLUS, op is int} {testobj} {
    set x [testintobj set 1 1]
    expr {+ $x}
} 1
test execute-3.50 {TclExecuteByteCode, INST_UPLUS, op is double} {testobj} {
    set x [testdoubleobj set 1 1.0]
    expr {+ $x}
} 1.0
test execute-3.51 {TclExecuteByteCode, INST_UPLUS, op is double with string} {testobj} {
    set x [testintobj set 1 1]
    testobj convert 1 double
    expr {+ $x}
} 1
test execute-3.52 {TclExecuteByteCode, INST_UPLUS, op is string int} {testobj} {
    set x [teststringobj set 1 1]
    expr {+ $x}
} 1
test execute-3.53 {TclExecuteByteCode, INST_UPLUS, op is string double} {testobj} {
    set x [teststringobj set 1 1.0]
    expr {+ $x}
} 1.0
test execute-3.54 {TclExecuteByteCode, INST_UPLUS, op is non-numeric} {testobj} {
    set x [teststringobj set 1 foo]
    list [catch {expr {+ $x}} msg] $msg
} {1 {can't use non-numeric string as operand of "+"}}

# INST_UMINUS is partially tested:
test execute-3.55 {TclExecuteByteCode, INST_UMINUS, op is int} {testobj} {
    set x [testintobj set 1 1]
    expr {- $x}
} -1
test execute-3.56 {TclExecuteByteCode, INST_UMINUS, op is double} {testobj} {
    set x [testdoubleobj set 1 1.0]
    expr {- $x}
} -1.0
test execute-3.57 {TclExecuteByteCode, INST_UMINUS, op is double with string} {testobj} {
    set x [testintobj set 1 1]
    testobj convert 1 double
    expr {- $x}
} -1
test execute-3.58 {TclExecuteByteCode, INST_UMINUS, op is string int} {testobj} {
    set x [teststringobj set 1 1]
    expr {- $x}
} -1
test execute-3.59 {TclExecuteByteCode, INST_UMINUS, op is string double} {testobj} {
    set x [teststringobj set 1 1.0]
    expr {- $x}
} -1.0
test execute-3.60 {TclExecuteByteCode, INST_UMINUS, op is non-numeric} {testobj} {
    set x [teststringobj set 1 foo]
    list [catch {expr {- $x}} msg] $msg
} {1 {can't use non-numeric string as operand of "-"}}

# INST_LNOT is partially tested:
test execute-3.61 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} {
    set x [testintobj set 1 2]
    expr {! $x}
} 0
test execute-3.62 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} {
    set x [testintobj set 1 0]
    expr {! $x}
} 1
test execute-3.63 {TclExecuteByteCode, INST_LNOT, op is double} {testobj} {
    set x [testdoubleobj set 1 1.0]
    expr {! $x}
} 0
test execute-3.64 {TclExecuteByteCode, INST_LNOT, op is double} {testobj} {
    set x [testdoubleobj set 1 0.0]
    expr {! $x}
} 1
test execute-3.65 {TclExecuteByteCode, INST_LNOT, op is double with string} {testobj} {
    set x [testintobj set 1 1]
    testobj convert 1 double
    expr {! $x}
} 0
test execute-3.66 {TclExecuteByteCode, INST_LNOT, op is double with string} {testobj} {
    set x [testintobj set 1 0]
    testobj convert 1 double
    expr {! $x}
} 1
test execute-3.67 {TclExecuteByteCode, INST_LNOT, op is string int} {testobj} {
    set x [teststringobj set 1 1]
    expr {! $x}
} 0
test execute-3.68 {TclExecuteByteCode, INST_LNOT, op is string int} {testobj} {
    set x [teststringobj set 1 0]
    expr {! $x}
} 1
test execute-3.69 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} {
    set x [teststringobj set 1 1.0]
    expr {! $x}
} 0
test execute-3.70 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} {
    set x [teststringobj set 1 0.0]
    expr {! $x}
} 1
test execute-3.71 {TclExecuteByteCode, INST_LNOT, op is non-numeric} {testobj} {
    set x [teststringobj set 1 foo]
    list [catch {expr {! $x}} msg] $msg
} {1 {can't use non-numeric string as operand of "!"}}

# INST_BITNOT not tested
# INST_CALL_BUILTIN_FUNC1 not tested
# INST_CALL_FUNC1 not tested

# INST_TRY_CVT_TO_NUMERIC is partially tested:
test execute-3.72 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is int} {testobj} {
    set x [testintobj set 1 1]
    expr {$x}
} 1
test execute-3.73 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is double} {testobj} {
    set x [testdoubleobj set 1 1.0]
    expr {$x}
} 1.0
test execute-3.74 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is double with string} {testobj} {
    set x [testintobj set 1 1]
    testobj convert 1 double
    expr {$x}
} 1
test execute-3.75 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is string int} {testobj} {
    set x [teststringobj set 1 1]
    expr {$x}
} 1
test execute-3.76 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is string double} {testobj} {
    set x [teststringobj set 1 1.0]
    expr {$x}
} 1.0
test execute-3.77 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is non-numeric} {testobj} {
    set x [teststringobj set 1 foo]
    expr {$x}
} foo

# INST_BREAK not tested
# INST_CONTINUE not tested
# INST_FOREACH_START4 not tested
# INST_FOREACH_STEP4 not tested
# INST_BEGIN_CATCH4 not tested
# INST_END_CATCH not tested
# INST_PUSH_RESULT not tested
# INST_PUSH_RETURN_CODE not tested

test execute-4.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} {
    catch {eval namespace delete [namespace children :: test_ns_*]}
    catch {unset x}
    catch {unset y}
    namespace eval test_ns_1 {
        namespace export cmd1
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
    }
    namespace eval test_ns_1::test_ns_2 {
        namespace import ::test_ns_1::*
    }
    set x "test_ns_1::"
    set y "test_ns_2::"
    list [namespace which -command ${x}${y}cmd1] \
         [catch {namespace which -command ${x}${y}cmd2} msg] $msg \
         [catch {namespace which -command ${x}${y}:cmd2} msg] $msg
} {::test_ns_1::test_ns_2::cmd1 0 {} 0 {}}
test execute-4.2 {Tcl_GetCommandFromObj, check if cached tclCmdNameType is invalid} {
    catch {eval namespace delete [namespace children :: test_ns_*]}
    catch {rename foo ""}
    catch {unset l}
    proc foo {} {
        return "global foo"
    }
    namespace eval test_ns_1 {
        proc whichFoo {} {
            return [namespace which -command foo]
        }
    }
    set l ""
    lappend l [test_ns_1::whichFoo]
    namespace eval test_ns_1 {
        proc foo {} {
            return "namespace foo"
        }
    }
    lappend l [test_ns_1::whichFoo]
    set l
} {::foo ::test_ns_1::foo}
test execute-4.3 {Tcl_GetCommandFromObj, command never found} {
    catch {eval namespace delete [namespace children :: test_ns_*]}
    catch {rename foo ""}
    namespace eval test_ns_1 {
        proc foo {} {
            return "namespace foo"
        }
    }
    namespace eval test_ns_1 {
        proc foo {} {
            return "namespace foo"
        }
    }
    list [namespace eval test_ns_1 {namespace which -command foo}] \
         [rename test_ns_1::foo ""] \
         [catch {namespace eval test_ns_1 {namespace which -command foo}} msg] $msg
} {::test_ns_1::foo {} 0 {}}

test execute-5.1 {SetCmdNameFromAny, set cmd name to empty heap string if NULL} {
    catch {eval namespace delete [namespace children :: test_ns_*]}
    catch {unset l}
    proc {} {} {return {}}
    {}
    set l {}
    lindex {} 0
    {}
} {}

test execute-6.1 {UpdateStringOfCmdName: called for duplicate of empty cmdName object} {
    proc {} {} {}
    proc { } {} {}
    proc p {} {
        set x {}
        $x
        append x { }
        $x
    }
    p
} {}

test execute-6.2 {Evaluate an expression in a variable; compile the first time, do not the second} {
    set w {3*5}
    proc a {obj} {expr $obj}
    set res "[a $w]:[a $w]"
} {15:15}

test execute-7.0 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
    set x 0x100000000
    expr {$x && 1}
} 1
test execute-7.1 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
    expr {0x100000000 && 1}
} 1
test execute-7.2 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
    expr {1 && 0x100000000}
} 1
test execute-7.3 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
    expr {wide(0x100000000) && 1}
} 1
test execute-7.4 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
    expr {1 && wide(0x100000000)}
} 1
test execute-7.5 {Wide int handling in INST_EQ} {longIs32bit} {
    expr {4 == (wide(1)+wide(3))}
} 1
test execute-7.6 {Wide int handling in INST_EQ and [incr]} {longIs32bit} {
    set x 399999999999
    expr {400000000000 == [incr x]}
} 1
# wide ints have more bits of precision than doubles, but we convert anyway
test execute-7.7 {Wide int handling in INST_EQ and [incr]} {longIs32bit} {
    set x [expr {wide(1)<<62}]
    set y [expr {$x+1}]
    expr {double($x) == double($y)}
} 1
test execute-7.8 {Wide int conversions can change sign} {longIs32bit} {
    set x 0x80000000
    expr {int($x) < wide($x)}
} 1
test execute-7.9 {Wide int handling in INST_MOD} {longIs32bit} {
    expr {(wide(1)<<60) % ((wide(47)<<45)-1)}
} 316659348800185
test execute-7.10 {Wide int handling in INST_MOD} {longIs32bit} {
    expr {((wide(1)<<60)-1) % 0x400000000}
} 17179869183
test execute-7.11 {Wide int handling in INST_LSHIFT} {longIs32bit} {
    expr wide(42)<<30
} 45097156608
test execute-7.12 {Wide int handling in INST_LSHIFT} {longIs32bit} {
    expr 12345678901<<3
} 98765431208
test execute-7.13 {Wide int handling in INST_RSHIFT} {longIs32bit} {
    expr 0x543210febcda9876>>7
} 47397893236700464
test execute-7.14 {Wide int handling in INST_RSHIFT} {longIs32bit} {
    expr 0x9876543210febcda>>7
} -58286587177206407
test execute-7.15 {Wide int handling in INST_BITOR} {longIs32bit} {
    expr 0x9876543210febcda | 0x543210febcda9876
} -2560765885044310786
test execute-7.16 {Wide int handling in INST_BITXOR} {longIs32bit} {
    expr 0x9876543210febcda ^ 0x543210febcda9876
} -3727778945703861076
test execute-7.17 {Wide int handling in INST_BITAND} {longIs32bit} {
    expr 0x9876543210febcda & 0x543210febcda9876
} 1167013060659550290
test execute-7.18 {Wide int handling in INST_ADD} {longIs32bit} {
    expr wide(0x7fffffff)+wide(0x7fffffff)
} 4294967294
test execute-7.19 {Wide int handling in INST_ADD} {longIs32bit} {
    expr 0x7fffffff+wide(0x7fffffff)
} 4294967294
test execute-7.20 {Wide int handling in INST_ADD} {longIs32bit} {
    expr wide(0x7fffffff)+0x7fffffff
} 4294967294
test execute-7.21 {Wide int handling in INST_ADD} {longIs32bit} {
    expr double(0x7fffffff)+wide(0x7fffffff)
} 4294967294.0
test execute-7.22 {Wide int handling in INST_ADD} {longIs32bit} {
    expr wide(0x7fffffff)+double(0x7fffffff)
} 4294967294.0
test execute-7.23 {Wide int handling in INST_SUB} {longIs32bit} {
    expr 0x123456789a-0x20406080a
} 69530054800
test execute-7.24 {Wide int handling in INST_MULT} {longIs32bit} {
    expr 0x123456789a*193
} 15090186251290
test execute-7.25 {Wide int handling in INST_DIV} {longIs32bit} {
    expr 0x123456789a/193
} 405116546
test execute-7.26 {Wide int handling in INST_UPLUS} {longIs32bit} {
    set x 0x123456871234568
    expr {+ $x}
} 81985533099853160
test execute-7.27 {Wide int handling in INST_UMINUS} {longIs32bit} {
    set x 0x123456871234568
    expr {- $x}
} -81985533099853160
test execute-7.28 {Wide int handling in INST_LNOT} {longIs32bit} {
    set x 0x123456871234568
    expr {! $x}
} 0
test execute-7.29 {Wide int handling in INST_BITNOT} {longIs32bit} {
    set x 0x123456871234568
    expr {~ $x}
} -81985533099853161
test execute-7.30 {Wide int handling in function call} {longIs32bit} {
    set x 0x12345687123456
    incr x
    expr {log($x) == log(double($x))}
} 1
test execute-7.31 {Wide int handling in abs()} {longIs32bit} {
    set x 0xa23456871234568
    incr x
    set y 0x123456871234568
    concat [expr {abs($x)}] [expr {abs($y)}]
} {730503879441204585 81985533099853160}
test execute-7.32 {Wide int handling} {longIs32bit} {
    expr {1024 * 1024 * 1024 * 1024}
} 0
test execute-7.33 {Wide int handling} {longIs32bit} {
    expr {0x1 * 1024 * 1024 * 1024 * 1024}
} 0
test execute-7.34 {Wide int handling} {longIs32bit} {
    expr {wide(0x1) * 1024 * 1024 * 1024 * 1024}
} 1099511627776

# cleanup
if {[info commands testobj] != {}} {
   testobj freeallvars
}
catch {eval namespace delete [namespace children :: test_ns_*]}
catch {rename foo ""}
catch {rename p ""}
catch {rename {} ""}
catch {rename { } ""}
catch {unset x}
catch {unset y}
catch {unset msg}
::tcltest::cleanupTests
return