Following a suggestion by wdi@ccc.uni-erlangen.de (Wolf-Dietrich Ihlenfeldt),

This implements support for linking wide-int variables to Tcl variables.
It also moves the link-var system towards using 8.*-based interfaces!

5 files changed, 309 insertions, 237 deletions

diff --git a/doc/LinkVar.3 b/doc/LinkVar.3
index 0a4a58f..e4ec181 100644
--- a/doc/LinkVar.3
+++ b/doc/LinkVar.3
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: LinkVar.3,v 1.3 2000/04/14 23:01:51 hobbs Exp $
+'\" RCS: @(#) $Id: LinkVar.3,v 1.3.16.1 2001/11/07 13:35:21 dkf Exp $
 '\" 
 .so man.macros
 .TH Tcl_LinkVar 3 7.5 Tcl "Tcl Library Procedures"
@@ -34,6 +34,9 @@ temporary modifications to it while parsing the variable name.
 Address of C variable that is to be linked to \fIvarName\fR.
 .AP int type in
 Type of C variable.  Must be one of TCL_LINK_INT, TCL_LINK_DOUBLE,
+.VS 8.4
+TCL_LINK_WIDE_INT,
+.VE 8.4
 TCL_LINK_BOOLEAN, or TCL_LINK_STRING, optionally OR'ed with
 TCL_LINK_READ_ONLY to make Tcl variable read-only.
 .BE
@@ -58,17 +61,27 @@ TCL_LINK_READ_ONLY:
 \fBTCL_LINK_INT\fR
 The C variable is of type \fBint\fR.
 Any value written into the Tcl variable must have a proper integer
-form acceptable to \fBTcl_GetInt\fR;  attempts to write
+form acceptable to \fBTcl_GetIntFromObj\fR;  attempts to write
 non-integer values into \fIvarName\fR will be rejected with
 Tcl errors.
 .TP
 \fBTCL_LINK_DOUBLE\fR
 The C variable is of type \fBdouble\fR.
 Any value written into the Tcl variable must have a proper real
-form acceptable to \fBTcl_GetDouble\fR;  attempts to write
+form acceptable to \fBTcl_GetDoubleFromObj\fR;  attempts to write
 non-real values into \fIvarName\fR will be rejected with
 Tcl errors.
 .TP
+\fBTCL_LINK_WIDE_INT\fR
+.VS 8.4
+The C variable is of type \fBTcl_WideInt\fR (which is an integer type
+at least 64-bits wide on all platforms that can support it.)
+Any value written into the Tcl variable must have a proper integer
+form acceptable to \fBTcl_GetWideIntFromObj\fR;  attempts to write
+non-integer values into \fIvarName\fR will be rejected with
+Tcl errors.
+.VE 8.4
+.TP
 \fBTCL_LINK_BOOLEAN\fR
 The C variable is of type \fBint\fR.
 If its value is zero then it will read from Tcl as ``0'';
@@ -76,7 +89,7 @@ otherwise it will read from Tcl as ``1''.
 Whenever \fIvarName\fR is
 modified, the C variable will be set to a 0 or 1 value.
 Any value written into the Tcl variable must have a proper boolean
-form acceptable to \fBTcl_GetBoolean\fR;  attempts to write
+form acceptable to \fBTcl_GetBooleanFromObj\fR;  attempts to write
 non-boolean values into \fIvarName\fR will be rejected with
 Tcl errors.
 .TP
diff --git a/generic/tcl.h b/generic/tcl.h
index e86be74..d801aab 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tcl.h,v 1.102.2.21 2001/10/19 13:07:15 dkf Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.102.2.22 2001/11/07 13:35:21 dkf Exp $
  */
 
 #ifndef _TCL
@@ -1041,6 +1041,7 @@ typedef struct Tcl_DString {
 #define TCL_LINK_DOUBLE		2
 #define TCL_LINK_BOOLEAN	3
 #define TCL_LINK_STRING		4
+#define TCL_LINK_WIDE_INT	5
 #define TCL_LINK_READ_ONLY	0x80
 
 
diff --git a/generic/tclLink.c b/generic/tclLink.c
index 20f9191..60d7bf0 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclLink.c,v 1.3 1999/04/16 00:46:49 stanton Exp $
+ * RCS: @(#) $Id: tclLink.c,v 1.3.26.1 2001/11/07 13:35:21 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -26,7 +26,7 @@
 
 typedef struct Link {
     Tcl_Interp *interp;		/* Interpreter containing Tcl variable. */
-    char *varName;		/* Name of variable (must be global).  This
+    Tcl_Obj *varName;		/* Name of variable (must be global).  This
 				 * is needed during trace callbacks, since
 				 * the actual variable may be aliased at
 				 * that time via upvar. */
@@ -35,6 +35,7 @@ typedef struct Link {
     union {
 	int i;
 	double d;
+	Tcl_WideInt w;
     } lastValue;		/* Last known value of C variable;  used to
 				 * avoid string conversions. */
     int flags;			/* Miscellaneous one-bit values;  see below
@@ -61,8 +62,7 @@ typedef struct Link {
 static char *		LinkTraceProc _ANSI_ARGS_((ClientData clientData,
 			    Tcl_Interp *interp, char *name1, char *name2,
 			    int flags));
-static char *		StringValue _ANSI_ARGS_((Link *linkPtr,
-			    char *buffer));
+static Tcl_Obj *	ObjValue _ANSI_ARGS_((Link *linkPtr));
 
 /*
  *----------------------------------------------------------------------
@@ -96,13 +96,12 @@ Tcl_LinkVar(interp, varName, addr, type)
 				 * OR'ed in. */
 {
     Link *linkPtr;
-    char buffer[TCL_DOUBLE_SPACE];
     int code;
 
     linkPtr = (Link *) ckalloc(sizeof(Link));
     linkPtr->interp = interp;
-    linkPtr->varName = (char *) ckalloc((unsigned) (strlen(varName) + 1));
-    strcpy(linkPtr->varName, varName);
+    linkPtr->varName = Tcl_NewStringObj(varName, -1);
+    Tcl_IncrRefCount(linkPtr->varName);
     linkPtr->addr = addr;
     linkPtr->type = type & ~TCL_LINK_READ_ONLY;
     if (type & TCL_LINK_READ_ONLY) {
@@ -110,9 +109,9 @@ Tcl_LinkVar(interp, varName, addr, type)
     } else {
 	linkPtr->flags = 0;
     }
-    if (Tcl_SetVar(interp, varName, StringValue(linkPtr, buffer),
+    if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 	    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
-	ckfree(linkPtr->varName);
+	Tcl_DecrRefCount(linkPtr->varName);
 	ckfree((char *) linkPtr);
 	return TCL_ERROR;
     }
@@ -120,7 +119,7 @@ Tcl_LinkVar(interp, varName, addr, type)
 	    |TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc,
 	    (ClientData) linkPtr);
     if (code != TCL_OK) {
-	ckfree(linkPtr->varName);
+	Tcl_DecrRefCount(linkPtr->varName);
 	ckfree((char *) linkPtr);
     }
     return code;
@@ -159,7 +158,7 @@ Tcl_UnlinkVar(interp, varName)
     Tcl_UntraceVar(interp, varName,
 	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
 	    LinkTraceProc, (ClientData) linkPtr);
-    ckfree(linkPtr->varName);
+    Tcl_DecrRefCount(linkPtr->varName);
     ckfree((char *) linkPtr);
 }
 
@@ -188,7 +187,6 @@ Tcl_UpdateLinkedVar(interp, varName)
     char *varName;		/* Name of global variable that is linked. */
 {
     Link *linkPtr;
-    char buffer[TCL_DOUBLE_SPACE];
     int savedFlag;
 
     linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
@@ -198,7 +196,7 @@ Tcl_UpdateLinkedVar(interp, varName)
     }
     savedFlag = linkPtr->flags & LINK_BEING_UPDATED;
     linkPtr->flags |= LINK_BEING_UPDATED;
-    Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer),
+    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 	    TCL_GLOBAL_ONLY);
     linkPtr->flags = (linkPtr->flags & ~LINK_BEING_UPDATED) | savedFlag;
 }
@@ -233,10 +231,9 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
     int flags;			/* Miscellaneous additional information. */
 {
     Link *linkPtr = (Link *) clientData;
-    int changed;
-    char buffer[TCL_DOUBLE_SPACE];
+    int changed, valueLength;
     char *value, **pp, *result;
-    Tcl_Obj *objPtr;
+    Tcl_Obj *objPtr, *valueObj;
 
     /*
      * If the variable is being unset, then just re-create it (with a
@@ -245,14 +242,14 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
 
     if (flags & TCL_TRACE_UNSETS) {
 	if (flags & TCL_INTERP_DESTROYED) {
-	    ckfree(linkPtr->varName);
+	    Tcl_DecrRefCount(linkPtr->varName);
 	    ckfree((char *) linkPtr);
 	} else if (flags & TCL_TRACE_DESTROYED) {
-	    Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer),
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 		    TCL_GLOBAL_ONLY);
-	    Tcl_TraceVar(interp, linkPtr->varName, TCL_GLOBAL_ONLY
-		    |TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
-		    LinkTraceProc, (ClientData) linkPtr);
+	    Tcl_TraceVar(interp, Tcl_GetString(linkPtr->varName),
+		    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
+		    |TCL_TRACE_UNSETS, LinkTraceProc, (ClientData) linkPtr);
 	}
 	return NULL;
     }
@@ -275,21 +272,24 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
 
     if (flags & TCL_TRACE_READS) {
 	switch (linkPtr->type) {
-	    case TCL_LINK_INT:
-	    case TCL_LINK_BOOLEAN:
-		changed = *(int *)(linkPtr->addr) != linkPtr->lastValue.i;
-		break;
-	    case TCL_LINK_DOUBLE:
-		changed = *(double *)(linkPtr->addr) != linkPtr->lastValue.d;
-		break;
-	    case TCL_LINK_STRING:
-		changed = 1;
-		break;
-	    default:
-		return "internal error: bad linked variable type";
+	case TCL_LINK_INT:
+	case TCL_LINK_BOOLEAN:
+	    changed = *(int *)(linkPtr->addr) != linkPtr->lastValue.i;
+	    break;
+	case TCL_LINK_DOUBLE:
+	    changed = *(double *)(linkPtr->addr) != linkPtr->lastValue.d;
+	    break;
+	case TCL_LINK_WIDE_INT:
+	    changed = *(Tcl_WideInt *)(linkPtr->addr) != linkPtr->lastValue.w;
+	    break;
+	case TCL_LINK_STRING:
+	    changed = 1;
+	    break;
+	default:
+	    return "internal error: bad linked variable type";
 	}
 	if (changed) {
-	    Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer),
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 		    TCL_GLOBAL_ONLY);
 	}
 	return NULL;
@@ -305,12 +305,12 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
      */
 
     if (linkPtr->flags & LINK_READ_ONLY) {
-	Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer),
+	Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 		TCL_GLOBAL_ONLY);
 	return "linked variable is read-only";
     }
-    value = Tcl_GetVar(interp, linkPtr->varName, TCL_GLOBAL_ONLY);
-    if (value == NULL) {
+    valueObj = Tcl_ObjGetVar2(interp, linkPtr->varName,NULL, TCL_GLOBAL_ONLY);
+    if (valueObj == NULL) {
 	/*
 	 * This shouldn't ever happen.
 	 */
@@ -323,48 +323,62 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
     result = NULL;
 
     switch (linkPtr->type) {
-	case TCL_LINK_INT:
-	    if (Tcl_GetInt(interp, value, &linkPtr->lastValue.i) != TCL_OK) {
-		Tcl_SetObjResult(interp, objPtr);
-		Tcl_SetVar(interp, linkPtr->varName,
-			StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY);
-		result = "variable must have integer value";
-		goto end;
-	    }
-	    *(int *)(linkPtr->addr) = linkPtr->lastValue.i;
-	    break;
-	case TCL_LINK_DOUBLE:
-	    if (Tcl_GetDouble(interp, value, &linkPtr->lastValue.d)
-		    != TCL_OK) {
-		Tcl_SetObjResult(interp, objPtr);
-		Tcl_SetVar(interp, linkPtr->varName,
-			StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY);
-		result = "variable must have real value";
-		goto end;
-	    }
-	    *(double *)(linkPtr->addr) = linkPtr->lastValue.d;
-	    break;
-	case TCL_LINK_BOOLEAN:
-	    if (Tcl_GetBoolean(interp, value, &linkPtr->lastValue.i)
-		    != TCL_OK) {
-		Tcl_SetObjResult(interp, objPtr);
-		Tcl_SetVar(interp, linkPtr->varName,
-			StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY);
-		result = "variable must have boolean value";
-		goto end;
-	    }
-	    *(int *)(linkPtr->addr) = linkPtr->lastValue.i;
-	    break;
-	case TCL_LINK_STRING:
-	    pp = (char **)(linkPtr->addr);
-	    if (*pp != NULL) {
-		ckfree(*pp);
-	    }
-	    *pp = (char *) ckalloc((unsigned) (strlen(value) + 1));
-	    strcpy(*pp, value);
-	    break;
-	default:
-	    return "internal error: bad linked variable type";
+    case TCL_LINK_INT:
+	if (Tcl_GetIntFromObj(interp, valueObj, &linkPtr->lastValue.i)
+		!= TCL_OK) {
+	    Tcl_SetObjResult(interp, objPtr);
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	    result = "variable must have integer value";
+	    goto end;
+	}
+	*(int *)(linkPtr->addr) = linkPtr->lastValue.i;
+	break;
+    case TCL_LINK_WIDE_INT:
+	if (Tcl_GetWideIntFromObj(interp, valueObj, &linkPtr->lastValue.w)
+		!= TCL_OK) {
+	    Tcl_SetObjResult(interp, objPtr);
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	    result = "variable must have integer value";
+	    goto end;
+	}
+	*(Tcl_WideInt *)(linkPtr->addr) = linkPtr->lastValue.w;
+	break;
+    case TCL_LINK_DOUBLE:
+	if (Tcl_GetDoubleFromObj(interp, valueObj, &linkPtr->lastValue.d)
+		!= TCL_OK) {
+	    Tcl_SetObjResult(interp, objPtr);
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	    result = "variable must have real value";
+	    goto end;
+	}
+	*(double *)(linkPtr->addr) = linkPtr->lastValue.d;
+	break;
+    case TCL_LINK_BOOLEAN:
+	if (Tcl_GetBooleanFromObj(interp, valueObj, &linkPtr->lastValue.i)
+	    != TCL_OK) {
+	    Tcl_SetObjResult(interp, objPtr);
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	    result = "variable must have boolean value";
+	    goto end;
+	}
+	*(int *)(linkPtr->addr) = linkPtr->lastValue.i;
+	break;
+    case TCL_LINK_STRING:
+	value = Tcl_GetStringFromObj(valueObj, &valueLength);
+	valueLength++;
+	pp = (char **)(linkPtr->addr);
+	if (*pp != NULL) {
+	    ckfree(*pp);
+	}
+	*pp = (char *) ckalloc((unsigned) valueLength);
+	memcpy(*pp, value, (unsigned) valueLength);
+	break;
+    default:
+	return "internal error: bad linked variable type";
     }
     end:
     Tcl_DecrRefCount(objPtr);
@@ -374,13 +388,13 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
 /*
  *----------------------------------------------------------------------
  *
- * StringValue --
+ * ObjValue --
  *
- *	Converts the value of a C variable to a string for use in a
+ *	Converts the value of a C variable to a Tcl_Obj* for use in a
  *	Tcl variable to which it is linked.
  *
  * Results:
- *	The return value is a pointer to a string that represents
+ *	The return value is a pointer to a Tcl_Obj that represents
  *	the value of the C variable given by linkPtr.
  *
  * Side effects:
@@ -389,42 +403,37 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
  *----------------------------------------------------------------------
  */
 
-static char *
-StringValue(linkPtr, buffer)
+static Tcl_Obj *
+ObjValue(linkPtr)
     Link *linkPtr;		/* Structure describing linked variable. */
-    char *buffer;		/* Small buffer to use for converting
-				 * values.  Must have TCL_DOUBLE_SPACE
-				 * bytes or more. */
 {
     char *p;
 
     switch (linkPtr->type) {
-	case TCL_LINK_INT:
-	    linkPtr->lastValue.i = *(int *)(linkPtr->addr);
-	    TclFormatInt(buffer, linkPtr->lastValue.i);
-	    return buffer;
-	case TCL_LINK_DOUBLE:
-	    linkPtr->lastValue.d = *(double *)(linkPtr->addr);
-	    Tcl_PrintDouble((Tcl_Interp *) NULL, linkPtr->lastValue.d, buffer);
-	    return buffer;
-	case TCL_LINK_BOOLEAN:
-	    linkPtr->lastValue.i = *(int *)(linkPtr->addr);
-	    if (linkPtr->lastValue.i != 0) {
-		return "1";
-	    }
-	    return "0";
-	case TCL_LINK_STRING:
-	    p = *(char **)(linkPtr->addr);
-	    if (p == NULL) {
-		return "NULL";
-	    }
-	    return p;
-    }
+    case TCL_LINK_INT:
+	linkPtr->lastValue.i = *(int *)(linkPtr->addr);
+	return Tcl_NewIntObj(linkPtr->lastValue.i);
+    case TCL_LINK_WIDE_INT:
+	linkPtr->lastValue.w = *(Tcl_WideInt *)(linkPtr->addr);
+	return Tcl_NewWideIntObj(linkPtr->lastValue.w);
+    case TCL_LINK_DOUBLE:
+	linkPtr->lastValue.d = *(double *)(linkPtr->addr);
+	return Tcl_NewDoubleObj(linkPtr->lastValue.d);
+    case TCL_LINK_BOOLEAN:
+	linkPtr->lastValue.i = *(int *)(linkPtr->addr);
+	return Tcl_NewBooleanObj(linkPtr->lastValue.i != 0);
+    case TCL_LINK_STRING:
+	p = *(char **)(linkPtr->addr);
+	if (p == NULL) {
+	    return Tcl_NewStringObj("NULL", 4);
+	}
+	return Tcl_NewStringObj(p, -1);
 
     /*
      * This code only gets executed if the link type is unknown
      * (shouldn't ever happen).
      */
-
-    return "??";
+    default:
+	return Tcl_NewStringObj("??", 2);
+    }
 }
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 902558f..e6baa25 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclTest.c,v 1.31.2.3 2001/10/09 15:30:51 dkf Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.31.2.4 2001/11/07 13:35:21 dkf Exp $
  */
 
 #define TCL_TEST
@@ -1974,22 +1974,31 @@ TestlinkCmd(dummy, interp, argc, argv)
     static int intVar = 43;
     static int boolVar = 4;
     static double realVar = 1.23;
+    static Tcl_WideInt wideVar = Tcl_LongAsWide(79);
     static char *stringVar = NULL;
     static int created = 0;
-    char buffer[TCL_DOUBLE_SPACE];
+    char buffer[2*TCL_DOUBLE_SPACE];
     int writable, flag;
+    Tcl_Obj *tmp;
 
     if (argc < 2) {
 	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" option ?arg arg arg?\"", (char *) NULL);
+		" option ?arg arg arg arg arg?\"", (char *) NULL);
 	return TCL_ERROR;
     }
     if (strcmp(argv[1], "create") == 0) {
+	if (argc != 7) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"",
+		argv[0], " ", argv[1],
+		" intRO realRO boolRO stringRO wideRO\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
 	if (created) {
 	    Tcl_UnlinkVar(interp, "int");
 	    Tcl_UnlinkVar(interp, "real");
 	    Tcl_UnlinkVar(interp, "bool");
 	    Tcl_UnlinkVar(interp, "string");
+	    Tcl_UnlinkVar(interp, "wide");
 	}
 	created = 1;
 	if (Tcl_GetBoolean(interp, argv[2], &writable) != TCL_OK) {
@@ -2024,11 +2033,20 @@ TestlinkCmd(dummy, interp, argc, argv)
 		TCL_LINK_STRING | flag) != TCL_OK) {
 	    return TCL_ERROR;
 	}
+	if (Tcl_GetBoolean(interp, argv[6], &writable) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
+	if (Tcl_LinkVar(interp, "wide", (char *) &wideVar,
+			TCL_LINK_WIDE_INT | flag) != TCL_OK) {
+	    return TCL_ERROR;
+	}
     } else if (strcmp(argv[1], "delete") == 0) {
 	Tcl_UnlinkVar(interp, "int");
 	Tcl_UnlinkVar(interp, "real");
 	Tcl_UnlinkVar(interp, "bool");
 	Tcl_UnlinkVar(interp, "string");
+	Tcl_UnlinkVar(interp, "wide");
 	created = 0;
     } else if (strcmp(argv[1], "get") == 0) {
 	TclFormatInt(buffer, intVar);
@@ -2038,11 +2056,18 @@ TestlinkCmd(dummy, interp, argc, argv)
 	TclFormatInt(buffer, boolVar);
 	Tcl_AppendElement(interp, buffer);
 	Tcl_AppendElement(interp, (stringVar == NULL) ? "-" : stringVar);
+	/*
+	 * Wide ints only have an object-based interface.
+	 */
+	tmp = Tcl_NewWideIntObj(wideVar);
+	Tcl_AppendElement(interp, Tcl_GetString(tmp));
+	Tcl_DecrRefCount(tmp);
     } else if (strcmp(argv[1], "set") == 0) {
-	if (argc != 6) {
+	if (argc != 7) {
 	    Tcl_AppendResult(interp, "wrong # args: should be \"",
-		argv[0], " ", argv[1],
-		"intValue realValue boolValue stringValue\"", (char *) NULL);
+		    argv[0], " ", argv[1],
+		    " intValue realValue boolValue stringValue wideValue\"",
+		    (char *) NULL);
 	    return TCL_ERROR;
 	}
 	if (argv[2][0] != 0) {
@@ -2071,11 +2096,20 @@ TestlinkCmd(dummy, interp, argc, argv)
 		strcpy(stringVar, argv[5]);
 	    }
 	}
+	if (argv[6][0] != 0) {
+	    tmp = Tcl_NewStringObj(argv[6], -1);
+	    if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) {
+		Tcl_DecrRefCount(tmp);
+		return TCL_ERROR;
+	    }
+	    Tcl_DecrRefCount(tmp);
+	}
     } else if (strcmp(argv[1], "update") == 0) {
-	if (argc != 6) {
+	if (argc != 7) {
 	    Tcl_AppendResult(interp, "wrong # args: should be \"",
-		argv[0], " ", argv[1],
-		"intValue realValue boolValue stringValue\"", (char *) NULL);
+		    argv[0], " ", argv[1],
+		    "intValue realValue boolValue stringValue wideValue\"",
+		    (char *) NULL);
 	    return TCL_ERROR;
 	}
 	if (argv[2][0] != 0) {
@@ -2108,6 +2142,15 @@ TestlinkCmd(dummy, interp, argc, argv)
 	    }
 	    Tcl_UpdateLinkedVar(interp, "string");
 	}
+	if (argv[6][0] != 0) {
+	    tmp = Tcl_NewStringObj(argv[6], -1);
+	    if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) {
+		Tcl_DecrRefCount(tmp);
+		return TCL_ERROR;
+	    }
+	    Tcl_DecrRefCount(tmp);
+	    Tcl_UpdateLinkedVar(interp, "wide");
+	}
     } else {
 	Tcl_AppendResult(interp, "bad option \"", argv[1],
 		"\": should be create, delete, get, set, or update",
diff --git a/tests/link.test b/tests/link.test
index f64711a..6ecb59f 100644
--- a/tests/link.test
+++ b/tests/link.test
@@ -11,246 +11,252 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: link.test,v 1.5 2000/04/10 17:19:01 ericm Exp $
+# RCS: @(#) $Id: link.test,v 1.5.16.1 2001/11/07 13:35:21 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
 
-if {[info commands testlink] == {}} {
-    puts "This application hasn't been compiled with the \"testlink\""
-    puts "command, so I can't test Tcl_LinkVar et al."
-    ::tcltest::cleanupTests
-    return
-}
+set ::tcltest::testConstraints(testlink) \
+        [expr {[info commands testlink] != {}}]
 
 foreach i {int real bool string} {
     catch {unset $i}
 }
-test link-1.1 {reading C variables from Tcl} {
+test link-1.1 {reading C variables from Tcl} {testlink} {
     testlink delete
-    testlink set 43 1.23 4 -
-    testlink create 1 1 1 1
-    list $int $real $bool $string
-} {43 1.23 1 NULL}
-test link-1.2 {reading C variables from Tcl} {
+    testlink set 43 1.23 4 - 12341234
+    testlink create 1 1 1 1 1
+    list $int $real $bool $string $wide
+} {43 1.23 1 NULL 12341234}
+test link-1.2 {reading C variables from Tcl} {testlink} {
     testlink delete
-    testlink create 1 1 1 1
-    testlink set -3 2 0 "A long string with spaces"
-    list $int $real $bool $string $int $real $bool $string
-} {-3 2.0 0 {A long string with spaces} -3 2.0 0 {A long string with spaces}}
+    testlink create 1 1 1 1 1
+    testlink set -3 2 0 "A long string with spaces"  43214321
+    list $int $real $bool $string $wide $int $real $bool $string $wide
+} {-3 2.0 0 {A long string with spaces} 43214321 -3 2.0 0 {A long string with spaces} 43214321}
 
-test link-2.1 {writing C variables from Tcl} {
+test link-2.1 {writing C variables from Tcl} {testlink} {
     testlink delete
-    testlink set 43 1.21 4 -
-    testlink create 1 1 1 1
+    testlink set 43 1.21 4 - 56785678
+    testlink create 1 1 1 1 1
     set int "00721"
     set real -10.5
     set bool true
     set string abcdef
-    concat [testlink get] $int $real $bool $string
-} {465 -10.5 1 abcdef 00721 -10.5 true abcdef}
-test link-2.2 {writing bad values into variables} {
+    set wide 135135
+    concat [testlink get] $int $real $bool $string $wide
+} {465 -10.5 1 abcdef 135135 00721 -10.5 true abcdef 135135}
+test link-2.2 {writing bad values into variables} {testlink} {
     testlink delete
-    testlink set 43 1.23 4 -
-    testlink create 1 1 1 1
+    testlink set 43 1.23 4 - 56785678
+    testlink create 1 1 1 1 1
     list [catch {set int 09a} msg] $msg $int
 } {1 {can't set "int": variable must have integer value} 43}
-test link-2.3 {writing bad values into variables} {
+test link-2.3 {writing bad values into variables} {testlink} {
     testlink delete
-    testlink set 43 1.23 4 -
-    testlink create 1 1 1 1
+    testlink set 43 1.23 4 - 56785678
+    testlink create 1 1 1 1 1
     list [catch {set real 1.x3} msg] $msg $real
 } {1 {can't set "real": variable must have real value} 1.23}
-test link-2.4 {writing bad values into variables} {
+test link-2.4 {writing bad values into variables} {testlink} {
     testlink delete
-    testlink set 43 1.23 4 -
-    testlink create 1 1 1 1
+    testlink set 43 1.23 4 - 56785678
+    testlink create 1 1 1 1 1
     list [catch {set bool gorp} msg] $msg $bool
 } {1 {can't set "bool": variable must have boolean value} 1}
+test link-2.5 {writing bad values into variables} {testlink} {
+    testlink delete
+    testlink set 43 1.23 4 - 56785678
+    testlink create 1 1 1 1 1
+    list [catch {set wide gorp} msg] $msg $bool
+} {1 {can't set "wide": variable must have integer value} 1}
 
-test link-3.1 {read-only variables} {
+test link-3.1 {read-only variables} {testlink} {
     testlink delete
-    testlink set 43 1.23 4 -
-    testlink create 0 1 1 0
+    testlink set 43 1.23 4 - 56785678
+    testlink create 0 1 1 0 0
     list [catch {set int 4} msg] $msg $int \
 	[catch {set real 10.6} msg] $msg $real \
 	[catch {set bool no} msg] $msg $bool \
-	[catch {set string "new value"} msg] $msg $string
-} {1 {can't set "int": linked variable is read-only} 43 0 10.6 10.6 0 no no 1 {can't set "string": linked variable is read-only} NULL}
-test link-3.2 {read-only variables} {
+	[catch {set string "new value"} msg] $msg $string \
+	[catch {set wide 12341234} msg] $msg $wide
+} {1 {can't set "int": linked variable is read-only} 43 0 10.6 10.6 0 no no 1 {can't set "string": linked variable is read-only} NULL 1 {can't set "wide": linked variable is read-only} 56785678}
+test link-3.2 {read-only variables} {testlink} {
     testlink delete
-    testlink set 43 1.23 4 -
-    testlink create 1 0 0 1
+    testlink set 43 1.23 4 - 56785678
+    testlink create 1 0 0 1 1
     list [catch {set int 4} msg] $msg $int \
 	[catch {set real 10.6} msg] $msg $real \
 	[catch {set bool no} msg] $msg $bool \
-	[catch {set string "new value"} msg] $msg $string
-} {0 4 4 1 {can't set "real": linked variable is read-only} 1.23 1 {can't set "bool": linked variable is read-only} 1 0 {new value} {new value}}
+	[catch {set string "new value"} msg] $msg $string\
+	[catch {set wide 12341234} msg] $msg $wide
+} {0 4 4 1 {can't set "real": linked variable is read-only} 1.23 1 {can't set "bool": linked variable is read-only} 1 0 {new value} {new value} 0 12341234 12341234}
 
-test link-4.1 {unsetting linked variables} {
+test link-4.1 {unsetting linked variables} {testlink} {
     testlink delete
-    testlink set -6 -2.5 0 stringValue
-    testlink create 1 1 1 1
-    unset int real bool string
+    testlink set -6 -2.5 0 stringValue 13579
+    testlink create 1 1 1 1 1
+    unset int real bool string wide
     list [catch {set int} msg] $msg [catch {set real} msg] $msg \
-	    [catch {set bool} msg] $msg [catch {set string} msg] $msg
-} {0 -6 0 -2.5 0 0 0 stringValue}
-test link-4.2 {unsetting linked variables} {
+	    [catch {set bool} msg] $msg [catch {set string} msg] $msg \
+	    [catch {set wide} msg] $msg
+} {0 -6 0 -2.5 0 0 0 stringValue 0 13579}
+test link-4.2 {unsetting linked variables} {testlink} {
     testlink delete
-    testlink set -6 -2.1 0 stringValue
-    testlink create 1 1 1 1
-    unset int real bool string
+    testlink set -6 -2.1 0 stringValue 97531
+    testlink create 1 1 1 1 1
+    unset int real bool string wide
     set int 102
     set real 16
     set bool true
     set string newValue
+    set wide 333555
     testlink get
-} {102 16.0 1 newValue}
+} {102 16.0 1 newValue 333555}
 
-test link-5.1 {unlinking variables} {
+test link-5.1 {unlinking variables} {testlink} {
     testlink delete
-    testlink set -6 -2.25 0 stringValue
+    testlink set -6 -2.25 0 stringValue 13579
     testlink delete
     set int xx1
     set real qrst
     set bool bogus
     set string 12345
+    set wide 875421
     testlink get
-} {-6 -2.25 0 stringValue}
-test link-5.2 {unlinking variables} {
+} {-6 -2.25 0 stringValue 13579}
+test link-5.2 {unlinking variables} {testlink} {
     testlink delete
-    testlink set -6 -2.25 0 stringValue
-    testlink create 1 1 1 1
+    testlink set -6 -2.25 0 stringValue 97531
+    testlink create 1 1 1 1 1
     testlink delete
-    testlink set 25 14.7 7 -
-    list $int $real $bool $string
-} {-6 -2.25 0 stringValue}
+    testlink set 25 14.7 7 - 999999
+    list $int $real $bool $string $wide
+} {-6 -2.25 0 stringValue 97531}
 
-test link-6.1 {errors in setting up link} {
+test link-6.1 {errors in setting up link} {testlink} {
     testlink delete
     catch {unset int}
     set int(44) 1
-    list [catch {testlink create 1 1 1 1} msg] $msg
+    list [catch {testlink create 1 1 1 1 1} msg] $msg
 } {1 {can't set "int": variable is array}}
 catch {unset int}
 
-test link-7.1 {access to linked variables via upvar} {
+test link-7.1 {access to linked variables via upvar} {testlink} {
     proc x {} {
 	upvar int y
 	unset y
     }
     testlink delete
-    testlink create 1 0 0 0
-    testlink set 14 {} {} {}
+    testlink create 1 0 0 0 0
+    testlink set 14 {} {} {} {}
     x
     list [catch {set int} msg] $msg
 } {0 14}
-test link-7.2 {access to linked variables via upvar} {
+test link-7.2 {access to linked variables via upvar} {testlink} {
     proc x {} {
 	upvar int y
 	return [set y]
     }
     testlink delete
-    testlink create 1 0 0 0
-    testlink set 0 {} {} {}
+    testlink create 1 0 0 0 0
+    testlink set 0 {} {} {} {}
     set int
-    testlink set 23 {} {} {}
+    testlink set 23 {} {} {} {}
     x
     list [x] $int
 } {23 23}
-test link-7.3 {access to linked variables via upvar} {
+test link-7.3 {access to linked variables via upvar} {testlink} {
     proc x {} {
 	upvar int y
 	set y 44
     }
     testlink delete
-    testlink create 0 0 0 0
-    testlink set 11 {} {} {}
+    testlink create 0 0 0 0 0
+    testlink set 11 {} {} {} {}
     list [catch x msg] $msg $int
 } {1 {can't set "y": linked variable is read-only} 11}
-test link-7.4 {access to linked variables via upvar} {
+test link-7.4 {access to linked variables via upvar} {testlink} {
     proc x {} {
 	upvar int y
 	set y abc
     }
     testlink delete
-    testlink create 1 1 1 1
-    testlink set -4 {} {} {}
+    testlink create 1 1 1 1 1
+    testlink set -4 {} {} {} {}
     list [catch x msg] $msg $int
 } {1 {can't set "y": variable must have integer value} -4}
-test link-7.5 {access to linked variables via upvar} {
+test link-7.5 {access to linked variables via upvar} {testlink} {
     proc x {} {
 	upvar real y
 	set y abc
     }
     testlink delete
-    testlink create 1 1 1 1
-    testlink set -4 16.75 {} {}
+    testlink create 1 1 1 1 1
+    testlink set -4 16.75 {} {} {}
     list [catch x msg] $msg $real
 } {1 {can't set "y": variable must have real value} 16.75}
-test link-7.6 {access to linked variables via upvar} {
+test link-7.6 {access to linked variables via upvar} {testlink} {
     proc x {} {
 	upvar bool y
 	set y abc
     }
     testlink delete
-    testlink create 1 1 1 1
-    testlink set -4 16.3 1 {}
+    testlink create 1 1 1 1 1
+    testlink set -4 16.3 1 {} {}
     list [catch x msg] $msg $bool
 } {1 {can't set "y": variable must have boolean value} 1}
+test link-7.7 {access to linked variables via upvar} {testlink} {
+    proc x {} {
+	upvar wide y
+	set y abc
+    }
+    testlink delete
+    testlink create 1 1 1 1 1
+    testlink set -4 16.3 1 {} 778899
+    list [catch x msg] $msg $wide
+} {1 {can't set "y": variable must have integer value} 778899}
 
-test link-8.1 {Tcl_UpdateLinkedVar procedure} {
+test link-8.1 {Tcl_UpdateLinkedVar procedure} {testlink} {
     proc x args {
-	global x int real bool string
-	lappend x $args $int $real $bool $string
+	global x int real bool string wide
+	lappend x $args $int $real $bool $string $wide
     }
     set x {}
-    testlink create 1 1 1 1
-    testlink set 14 -2.0 0 xyzzy
+    testlink create 1 1 1 1 1
+    testlink set 14 -2.0 0 xyzzy 995511
     trace var int w x
-    testlink update 32 4.0 3 abcd
+    testlink update 32 4.0 3 abcd 113355
     trace vdelete int w x
     set x
-} {{int {} w} 32 -2.0 0 xyzzy}
-test link-8.2 {Tcl_UpdateLinkedVar procedure} {
+} {{int {} w} 32 -2.0 0 xyzzy 995511}
+test link-8.2 {Tcl_UpdateLinkedVar procedure} {testlink} {
     proc x args {
-	global x int real bool string
-	lappend x $args $int $real $bool $string
+	global x int real bool string wide
+	lappend x $args $int $real $bool $string $wide
     }
     set x {}
-    testlink create 1 1 1 1
-    testlink set 14 -2.0 0 xyzzy
+    testlink create 1 1 1 1 1
+    testlink set 14 -2.0 0 xyzzy 995511
     testlink delete
     trace var int w x
-    testlink update 32 4.0 6 abcd
+    testlink update 32 4.0 6 abcd 113355
     trace vdelete int w x
     set x
 } {}
-test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} {
-    testlink create 0 0 0 0
-    list [catch {testlink update 47 {} {} {}} msg] $msg $int
+test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} {testlink} {
+    testlink create 0 0 0 0 0
+    list [catch {testlink update 47 {} {} {} {}} msg] $msg $int
 } {0 {} 47}
 
-testlink set 0 0 0 -
-testlink delete
-foreach i {int real bool string} {
+catch {testlink set 0 0 0 - 0}
+catch {testlink delete}
+foreach i {int real bool string wide} {
     catch {unset $i}
 }
 
 # cleanup
 ::tcltest::cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-