Tcl Source Code

1999-03-24    <[email protected]>

	* tests/execute.test: 
	* generic/tclExecute.c (TclExecuteByteCode): Fixed expression code
	that incorrectly returned floating point values for integers if
	the internal rep happened to be a double.  Now we check to see if
	the object has a string rep that looks like an integer before
	using the double internal rep. [Bug: 1516]

1999-03-24    <[email protected]>

	* generic/tclAlloc.c:
	* generic/tclEncoding.c:
	* generic/tclProc.c:
	* unix/tclUnixTime.c:
	* win/tclWinSerial.c: Fixed compilation warnings/errors for VC++

/* 
 * tclExecute.c --
 *
 *	This file contains procedures that execute byte-compiled Tcl
 *	commands.
 *
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclExecute.c,v 1.1.2.10 1999/03/25 03:55:31 stanton Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"

#ifdef NO_FLOAT_H
#   include "../compat/float.h"

		value2Ptr = POP_OBJECT();
		valuePtr  = POP_OBJECT();
		t1Ptr = valuePtr->typePtr;
		t2Ptr = value2Ptr->typePtr;
		
		if (t1Ptr == &tclIntType) {
		    i  = valuePtr->internalRep.longValue;
		} else if ((t1Ptr == &tclDoubleType)
			&& (valuePtr->bytes == NULL)) {
		    /*
		     * We can only use the internal rep directly if there is
		     * no string rep.  Otherwise the string rep might actually
		     * look like an integer, which is preferred.
		     */

		    d1 = valuePtr->internalRep.doubleValue;
		} else {
		    char *s = Tcl_GetStringFromObj(valuePtr, &length);
		    if (TclLooksLikeInt(s, length)) {
			result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
				valuePtr, &i);
		    } else {
			result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
				valuePtr, &d1);
		    }
		    if (result != TCL_OK) {
			TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n",
			       s, O2S(valuePtr),
			       (valuePtr->typePtr?
				    valuePtr->typePtr->name : "null")));
			IllegalExprOperandType(interp, pc, valuePtr);
			Tcl_DecrRefCount(valuePtr);
			Tcl_DecrRefCount(value2Ptr);
			goto checkForCatch;
		    }
		    t1Ptr = valuePtr->typePtr;
		}
		
		if (t2Ptr == &tclIntType) {
		    i2 = value2Ptr->internalRep.longValue;
		} else if ((t2Ptr == &tclDoubleType)
			&& (value2Ptr->bytes == NULL)) {
		    /*
		     * We can only use the internal rep directly if there is
		     * no string rep.  Otherwise the string rep might actually
		     * look like an integer, which is preferred.
		     */

		    d2 = value2Ptr->internalRep.doubleValue;
		} else {
		    char *s = Tcl_GetStringFromObj(value2Ptr, &length);
		    if (TclLooksLikeInt(s, length)) {
			result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
				value2Ptr, &i2);
		    } else {
			result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
				value2Ptr, &d2);
		    }
		    if (result != TCL_OK) {
			TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n",
			       O2S(value2Ptr), s,
			       (value2Ptr->typePtr?
				    value2Ptr->typePtr->name : "null")));
			IllegalExprOperandType(interp, pc, value2Ptr);
			Tcl_DecrRefCount(valuePtr);
			Tcl_DecrRefCount(value2Ptr);
			goto checkForCatch;
		    }

	         */

		double d;
		Tcl_ObjType *tPtr;
		
		valuePtr = stackPtr[stackTop];
		tPtr = valuePtr->typePtr;
		if ((tPtr != &tclIntType) && ((tPtr != &tclDoubleType)
			|| (valuePtr->bytes != NULL))) {
		    char *s = Tcl_GetStringFromObj(valuePtr, &length);
		    if (TclLooksLikeInt(s, length)) {
			result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
				valuePtr, &i);
		    } else {
			result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
				valuePtr, &d);

		 */
		
		double d;
		Tcl_ObjType *tPtr;
		
		valuePtr = POP_OBJECT();
		tPtr = valuePtr->typePtr;
		if ((tPtr != &tclIntType) && ((tPtr != &tclDoubleType)
			|| (valuePtr->bytes != NULL))) {
		    char *s = Tcl_GetStringFromObj(valuePtr, &length);
		    if (TclLooksLikeInt(s, length)) {
			result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
				valuePtr, &i);
		    } else {
			result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
				valuePtr, &d);

		char *s;
		Tcl_ObjType *tPtr;
		int converted, shared;

		valuePtr = stackPtr[stackTop];
		tPtr = valuePtr->typePtr;
		converted = 0;
		if ((tPtr != &tclIntType) && ((tPtr != &tclDoubleType)
			|| (valuePtr->bytes != NULL))) {
		    s = Tcl_GetStringFromObj(valuePtr, &length);
		    if (TclLooksLikeInt(s, length)) {
			result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
				valuePtr, &i);
		    } else {
			result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
				valuePtr, &d);

#
# Copyright (c) 1997 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: execute.test,v 1.1.2.6 1999/03/25 03:55:33 stanton Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

catch {eval namespace delete [namespace children :: test_ns_*]}
catch {rename foo ""}
catch {unset x}
catch {unset y}
catch {unset msg}

set ::tcltest::testConfig(testobj) \
	[expr {[info commands testobj] != {} \
	&& [info commands testdoubleobj] != {} \
	&& [info commands teststringobj] != {} \
	&& [info commands testobj] != {}}]

# Tests for the omnibus TclExecuteByteCode function:

# INST_DONE not tested
# INST_PUSH1 not tested
# INST_PUSH4 not tested
# INST_POP not tested
# INST_DUP not tested
# INST_CONCAT1 not tested
# INST_INVOKE_STK4 not tested
# INST_INVOKE_STK1 not tested
# INST_EVAL_STK not tested
# INST_EXPR_STK not tested
# INST_LOAD_SCALAR1 not tested
# INST_LOAD_SCALAR4 not tested
# INST_LOAD_SCALAR_STK not tested
# INST_LOAD_ARRAY4 not tested
# INST_LOAD_ARRAY1 not tested
# INST_LOAD_ARRAY_STK not tested
# INST_LOAD_STK not tested
# INST_STORE_SCALAR4 not tested
# INST_STORE_SCALAR1 not tested
# INST_STORE_SCALAR_STK not tested
# INST_STORE_ARRAY4 not tested
# INST_STORE_ARRAY1 not tested
# INST_STORE_ARRAY_STK not tested
# INST_STORE_STK not tested
# INST_INCR_SCALAR1 not tested
# INST_INCR_SCALAR_STK not tested
# INST_INCR_STK not tested
# INST_INCR_ARRAY1 not tested
# INST_INCR_ARRAY_STK not tested
# INST_INCR_SCALAR1_IMM not tested
# INST_INCR_SCALAR_STK_IMM not tested
# INST_INCR_STK_IMM not tested
# INST_INCR_ARRAY1_IMM not tested
# INST_INCR_ARRAY_STK_IMM not tested
# INST_JUMP1 not tested
# INST_JUMP4 not tested
# INST_JUMP_TRUE4 not tested
# INST_JUMP_TRUE1 not tested
# INST_JUMP_FALSE4 not tested
# INST_JUMP_FALSE1 not tested
# INST_LOR not tested
# INST_LAND not tested
# INST_EQ not tested
# INST_NEQ not tested
# INST_LT not tested
# INST_GT not tested
# INST_LE not tested
# INST_GE not tested
# INST_MOD not tested
# INST_LSHIFT not tested
# INST_RSHIFT not tested
# INST_BITOR not tested
# INST_BITXOR not tested
# INST_BITAND not tested

# INST_ADD is partially tested:
test execute-1.1 {TclExecuteByteCode, INST_ADD, op1 is int} {testobj} {
    set x [testintobj set 0 1]
    expr {$x + 1}
} 2
test execute-1.2 {TclExecuteByteCode, INST_ADD, op1 is double} {testobj} {
    set x [testdoubleobj set 0 1]
    expr {$x + 1}
} 2.0
test execute-1.3 {TclExecuteByteCode, INST_ADD, op1 is double with string} {testobj} {
    set x [testintobj set 0 1]
    testobj convert 0 double
    expr {$x + 1}
} 2
test execute-1.4 {TclExecuteByteCode, INST_ADD, op1 is string int} {testobj} {
    set x [teststringobj set 0 1]
    expr {$x + 1}
} 2
test execute-1.5 {TclExecuteByteCode, INST_ADD, op1 is string double} {testobj} {
    set x [teststringobj set 0 1.0]
    expr {$x + 1}
} 2.0
test execute-1.6 {TclExecuteByteCode, INST_ADD, op1 is non-numeric} {testobj} {
    set x [teststringobj set 0 foo]
    list [catch {expr {$x + 1}} msg] $msg
} {1 {can't use non-numeric string as operand of "+"}}
test execute-1.7 {TclExecuteByteCode, INST_ADD, op2 is int} {testobj} {
    set x [testintobj set 0 1]
    expr {1 + $x}
} 2
test execute-1.8 {TclExecuteByteCode, INST_ADD, op2 is double} {testobj} {
    set x [testdoubleobj set 0 1]
    expr {1 + $x}
} 2.0
test execute-1.9 {TclExecuteByteCode, INST_ADD, op2 is double with string} {testobj} {
    set x [testintobj set 0 1]
    testobj convert 0 double
    expr {1 + $x}
} 2
test execute-1.10 {TclExecuteByteCode, INST_ADD, op2 is string int} {testobj} {
    set x [teststringobj set 0 1]
    expr {1 + $x}
} 2
test execute-1.11 {TclExecuteByteCode, INST_ADD, op2 is string double} {testobj} {
    set x [teststringobj set 0 1.0]
    expr {1 + $x}
} 2.0
test execute-1.12 {TclExecuteByteCode, INST_ADD, op2 is non-numeric} {testobj} {
    set x [teststringobj set 0 foo]
    list [catch {expr {1 + $x}} msg] $msg
} {1 {can't use non-numeric string as operand of "+"}}

# INST_SUB is partially tested:
test execute-1.13 {TclExecuteByteCode, INST_SUB, op1 is int} {testobj} {
    set x [testintobj set 0 1]
    expr {$x - 1}
} 0
test execute-1.14 {TclExecuteByteCode, INST_SUB, op1 is double} {testobj} {
    set x [testdoubleobj set 0 1]
    expr {$x - 1}
} 0.0
test execute-1.15 {TclExecuteByteCode, INST_SUB, op1 is double with string} {testobj} {
    set x [testintobj set 0 1]
    testobj convert 0 double
    expr {$x - 1}
} 0
test execute-1.16 {TclExecuteByteCode, INST_SUB, op1 is string int} {testobj} {
    set x [teststringobj set 0 1]
    expr {$x - 1}
} 0
test execute-1.17 {TclExecuteByteCode, INST_SUB, op1 is string double} {testobj} {
    set x [teststringobj set 0 1.0]
    expr {$x - 1}
} 0.0
test execute-1.18 {TclExecuteByteCode, INST_SUB, op1 is non-numeric} {testobj} {
    set x [teststringobj set 0 foo]
    list [catch {expr {$x - 1}} msg] $msg
} {1 {can't use non-numeric string as operand of "-"}}
test execute-1.19 {TclExecuteByteCode, INST_SUB, op2 is int} {testobj} {
    set x [testintobj set 0 1]
    expr {1 - $x}
} 0
test execute-1.20 {TclExecuteByteCode, INST_SUB, op2 is double} {testobj} {
    set x [testdoubleobj set 0 1]
    expr {1 - $x}
} 0.0
test execute-1.21 {TclExecuteByteCode, INST_SUB, op2 is double with string} {testobj} {
    set x [testintobj set 0 1]
    testobj convert 0 double
    expr {1 - $x}
} 0
test execute-1.22 {TclExecuteByteCode, INST_SUB, op2 is string int} {testobj} {
    set x [teststringobj set 0 1]
    expr {1 - $x}
} 0
test execute-1.23 {TclExecuteByteCode, INST_SUB, op2 is string double} {testobj} {
    set x [teststringobj set 0 1.0]
    expr {1 - $x}
} 0.0
test execute-1.24 {TclExecuteByteCode, INST_SUB, op2 is non-numeric} {testobj} {
    set x [teststringobj set 0 foo]
    list [catch {expr {1 - $x}} msg] $msg
} {1 {can't use non-numeric string as operand of "-"}}

# INST_MULT is partially tested:
test execute-1.25 {TclExecuteByteCode, INST_MULT, op1 is int} {testobj} {
    set x [testintobj set 1 1]
    expr {$x * 1}
} 1
test execute-1.26 {TclExecuteByteCode, INST_MULT, op1 is double} {testobj} {
    set x [testdoubleobj set 1 2.0]
    expr {$x * 1}
} 2.0
test execute-1.27 {TclExecuteByteCode, INST_MULT, op1 is double with string} {testobj} {
    set x [testintobj set 1 2]
    testobj convert 1 double
    expr {$x * 1}
} 2
test execute-1.28 {TclExecuteByteCode, INST_MULT, op1 is string int} {testobj} {
    set x [teststringobj set 1 1]
    expr {$x * 1}
} 1
test execute-1.29 {TclExecuteByteCode, INST_MULT, op1 is string double} {testobj} {
    set x [teststringobj set 1 1.0]
    expr {$x * 1}
} 1.0
test execute-1.30 {TclExecuteByteCode, INST_MULT, op1 is non-numeric} {testobj} {
    set x [teststringobj set 1 foo]
    list [catch {expr {$x * 1}} msg] $msg
} {1 {can't use non-numeric string as operand of "*"}}
test execute-1.31 {TclExecuteByteCode, INST_MULT, op2 is int} {testobj} {
    set x [testintobj set 1 1]
    expr {1 * $x}
} 1
test execute-1.32 {TclExecuteByteCode, INST_MULT, op2 is double} {testobj} {
    set x [testdoubleobj set 1 2.0]
    expr {1 * $x}
} 2.0
test execute-1.33 {TclExecuteByteCode, INST_MULT, op2 is double with string} {testobj} {
    set x [testintobj set 1 2]
    testobj convert 1 double
    expr {1 * $x}
} 2
test execute-1.34 {TclExecuteByteCode, INST_MULT, op2 is string int} {testobj} {
    set x [teststringobj set 1 1]
    expr {1 * $x}
} 1
test execute-1.35 {TclExecuteByteCode, INST_MULT, op2 is string double} {testobj} {
    set x [teststringobj set 1 1.0]
    expr {1 * $x}
} 1.0
test execute-1.36 {TclExecuteByteCode, INST_MULT, op2 is non-numeric} {testobj} {
    set x [teststringobj set 1 foo]
    list [catch {expr {1 * $x}} msg] $msg
} {1 {can't use non-numeric string as operand of "*"}}

# INST_DIV is partially tested:
test execute-1.37 {TclExecuteByteCode, INST_DIV, op1 is int} {testobj} {
    set x [testintobj set 1 1]
    expr {$x / 1}
} 1
test execute-1.38 {TclExecuteByteCode, INST_DIV, op1 is double} {testobj} {
    set x [testdoubleobj set 1 2.0]
    expr {$x / 1}
} 2.0
test execute-1.39 {TclExecuteByteCode, INST_DIV, op1 is double with string} {testobj} {
    set x [testintobj set 1 2]
    testobj convert 1 double
    expr {$x / 1}
} 2
test execute-1.40 {TclExecuteByteCode, INST_DIV, op1 is string int} {testobj} {
    set x [teststringobj set 1 1]
    expr {$x / 1}
} 1
test execute-1.41 {TclExecuteByteCode, INST_DIV, op1 is string double} {testobj} {
    set x [teststringobj set 1 1.0]
    expr {$x / 1}
} 1.0
test execute-1.42 {TclExecuteByteCode, INST_DIV, op1 is non-numeric} {testobj} {
    set x [teststringobj set 1 foo]
    list [catch {expr {$x / 1}} msg] $msg
} {1 {can't use non-numeric string as operand of "/"}}
test execute-1.43 {TclExecuteByteCode, INST_DIV, op2 is int} {testobj} {
    set x [testintobj set 1 1]
    expr {2 / $x}
} 2
test execute-1.44 {TclExecuteByteCode, INST_DIV, op2 is double} {testobj} {
    set x [testdoubleobj set 1 1.0]
    expr {2 / $x}
} 2.0
test execute-1.45 {TclExecuteByteCode, INST_DIV, op2 is double with string} {testobj} {
    set x [testintobj set 1 1]
    testobj convert 1 double
    expr {2 / $x}
} 2
test execute-1.46 {TclExecuteByteCode, INST_DIV, op2 is string int} {testobj} {
    set x [teststringobj set 1 1]
    expr {2 / $x}
} 2
test execute-1.47 {TclExecuteByteCode, INST_DIV, op2 is string double} {testobj} {
    set x [teststringobj set 1 1.0]
    expr {2 / $x}
} 2.0
test execute-1.48 {TclExecuteByteCode, INST_DIV, op2 is non-numeric} {testobj} {
    set x [teststringobj set 1 foo]
    list [catch {expr {1 / $x}} msg] $msg
} {1 {can't use non-numeric string as operand of "/"}}

# INST_UPLUS is partially tested:
test execute-1.49 {TclExecuteByteCode, INST_UPLUS, op is int} {testobj} {
    set x [testintobj set 1 1]
    expr {+ $x}
} 1
test execute-1.50 {TclExecuteByteCode, INST_UPLUS, op is double} {testobj} {
    set x [testdoubleobj set 1 1.0]
    expr {+ $x}
} 1.0
test execute-1.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-1.52 {TclExecuteByteCode, INST_UPLUS, op is string int} {testobj} {
    set x [teststringobj set 1 1]
    expr {+ $x}
} 1
test execute-1.53 {TclExecuteByteCode, INST_UPLUS, op is string double} {testobj} {
    set x [teststringobj set 1 1.0]
    expr {+ $x}
} 1.0
test execute-1.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-1.55 {TclExecuteByteCode, INST_UMINUS, op is int} {testobj} {
    set x [testintobj set 1 1]
    expr {- $x}
} -1
test execute-1.56 {TclExecuteByteCode, INST_UMINUS, op is double} {testobj} {
    set x [testdoubleobj set 1 1.0]
    expr {- $x}
} -1.0
test execute-1.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-1.58 {TclExecuteByteCode, INST_UMINUS, op is string int} {testobj} {
    set x [teststringobj set 1 1]
    expr {- $x}
} -1
test execute-1.59 {TclExecuteByteCode, INST_UMINUS, op is string double} {testobj} {
    set x [teststringobj set 1 1.0]
    expr {- $x}
} -1.0
test execute-1.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-1.61 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} {
    set x [testintobj set 1 2]
    expr {! $x}
} 0
test execute-1.62 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} {
    set x [testintobj set 1 0]
    expr {! $x}
} 1
test execute-1.63 {TclExecuteByteCode, INST_LNOT, op is double} {testobj} {
    set x [testdoubleobj set 1 1.0]
    expr {! $x}
} 0
test execute-1.64 {TclExecuteByteCode, INST_LNOT, op is double} {testobj} {
    set x [testdoubleobj set 1 0.0]
    expr {! $x}
} 1
test execute-1.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-1.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-1.67 {TclExecuteByteCode, INST_LNOT, op is string int} {testobj} {
    set x [teststringobj set 1 1]
    expr {! $x}
} 0
test execute-1.68 {TclExecuteByteCode, INST_LNOT, op is string int} {testobj} {
    set x [teststringobj set 1 0]
    expr {! $x}
} 1
test execute-1.69 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} {
    set x [teststringobj set 1 1.0]
    expr {! $x}
} 0
test execute-1.70 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} {
    set x [teststringobj set 1 0.0]
    expr {! $x}
} 1
test execute-1.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-1.72 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is int} {testobj} {
    set x [testintobj set 1 1]
    expr {$x}
} 1
test execute-1.73 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is double} {testobj} {
    set x [testdoubleobj set 1 1.0]
    expr {$x}
} 1.0
test execute-1.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-1.75 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is string int} {testobj} {
    set x [teststringobj set 1 1]
    expr {$x}
} 1
test execute-1.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-1.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-2.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-2.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 foo {} {
            return "namespace foo"
        }
    }
    lappend l [test_ns_1::whichFoo]
    set l
} {::foo ::test_ns_1::foo}
test execute-2.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-3.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-4.1 {UpdateStringOfCmdName: called for duplicate of empty cmdName object} {
    proc {} {} {}
    proc { } {} {}
    proc p {} {
        set x {}
        $x
        append x { }
        $x

catch {rename {} ""}
catch {rename { } ""}
catch {unset x}
catch {unset y}
catch {unset msg}
::tcltest::cleanupTests
return