Tcl Source Code

	TclAllocObjStorage(objPtr);			\
	(objPtr)->refCount = 0;				\
	(objPtr)->bytes = NULL;				\
	(objPtr)->internalRep.wideValue = (Tcl_WideInt)(w);	\
	(objPtr)->typePtr = &tclIntType;		\
	TCL_DTRACE_OBJ_CREATE(objPtr);			\
    } while (0)

#define TclNewUIntObj(objPtr, uw) \
    do {						\
	TclIncrObjsAllocated();				\
	TclAllocObjStorage(objPtr);			\
	(objPtr)->refCount = 0;				\
	(objPtr)->bytes = NULL;				\
	Tcl_WideUInt uw_ = (uw);		\
	if (uw_ > WIDE_MAX) {			\
	    mp_int bignumValue_;		\
	    if (mp_init_u64(&bignumValue_, uw_) != MP_OKAY) {	\
		Tcl_Panic("%s: memory overflow", "TclNewUIntObj");	\
	    }	\
	    TclSetBignumInternalRep((objPtr), &bignumValue_);	\
	} else {	\
	    (objPtr)->internalRep.wideValue = (Tcl_WideInt)(uw_);	\
	    (objPtr)->typePtr = &tclIntType;		\
	}	\
	TCL_DTRACE_OBJ_CREATE(objPtr);			\
    } while (0)

#define TclNewIndexObj(objPtr, w) \
    TclNewIntObj(objPtr, w)

#define TclNewDoubleObj(objPtr, d) \
    do {							\
	TclIncrObjsAllocated();					\

	(objPtr)->typePtr = NULL;				\
	TCL_DTRACE_OBJ_CREATE(objPtr);				\
    } while (0)

#else /* TCL_MEM_DEBUG */
#define TclNewIntObj(objPtr, w) \
    (objPtr) = Tcl_NewWideIntObj(w)

#define TclNewUIntObj(objPtr, uw) \
    do {						\
	Tcl_WideUInt uw_ = (uw);		\
	if (uw_ > WIDE_MAX) {			\
	    mp_int bignumValue_;		\
	    if (mp_init_u64(&bignumValue_, uw_) == MP_OKAY) {	\
		(objPtr) = Tcl_NewBignumObj(&bignumValue_));	\
	    } else {	\
		(objPtr) = NULL; \
	    } \
	} else {	\
	    (objPtr) = Tcl_NewWideIntObj(uw_);	\
	}	\
    } while (0)

#define TclNewIndexObj(objPtr, w) \
    TclNewIntObj(objPtr, w)

#define TclNewDoubleObj(objPtr, d) \
    (objPtr) = Tcl_NewDoubleObj(d)

		/*
		 * If the sign bit is set (a negative value) or if the value
		 * can't possibly fit in the bits of an unsigned wide, there's
		 * no point in doing further conversion.
		 */
		return 1;
	    }
#ifndef WORDS_BIGENDIAN
	    while (numBytes-- > 0) {
		value = (value << CHAR_BIT) | *bytes++;
	    }
#else /* !WORDS_BIGENDIAN */
	    /*
	     * Little-endian can read the value directly.
	     */

	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.f = LinkedVar(float);
	return Tcl_NewDoubleObj(linkPtr->lastValue.f);
    case TCL_LINK_WIDE_UINT: {
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		TclNewUIntObj(objv[i],
			linkPtr->lastValue.uwPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.uw = LinkedVar(Tcl_WideUInt);
	Tcl_Obj *uwObj;
	TclNewUIntObj(uwObj, linkPtr->lastValue.uw);
	return uwObj;
	}

    case TCL_LINK_STRING:
	p = LinkedVar(char *);
	if (p == NULL) {
	    TclNewLiteralStringObj(resultObj, "NULL");
	    return resultObj;
	}

	    result[0] = TclOOObjectName(interp, declarerPtr);
	    result[1] = mPtr->namePtr;
	    Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
	    return TCL_OK;
	}
    case SELF_CALL:
	result[0] = TclOORenderCallChain(interp, contextPtr->callPtr);
	TclNewIndexObj(result[1], contextPtr->index);
	Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
	return TCL_OK;
    }
    return TCL_ERROR;
}

/*

    set uchar 161
    set short 8000
    set ushort 40000
    set uint 0xc001babe
    set long 34543
    set ulong 567890
    set float 1.0987654321
    set uwide 12345678901234567890
    concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
} -result {465 -10.5 1 abcdef 135135 79 161 8000 40000 -1073628482 34543 567890 1.0987653732299805 -6101065172474983726 | 0o0721 -10.5 true abcdef 135135 79 161 8000 40000 0xc001babe 34543 567890 1.0987654321 12345678901234567890}
test link-2.2 {writing bad values into variables} -setup {
    testlink delete
} -constraints {testlink} -body {
    testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    list [catch {set int 09a} msg] $msg $int
} -result {1 {can't set "int": variable must have integer value} 43}