summaryrefslogtreecommitdiffstats
path: root/generic/tclLink.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclLink.c')
-rw-r--r--generic/tclLink.c41
1 files changed, 24 insertions, 17 deletions
diff --git a/generic/tclLink.c b/generic/tclLink.c
index ca20e38..20f9191 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -8,12 +8,12 @@
* him.
*
* Copyright (c) 1993 The Regents of the University of California.
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1994-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: tclLink.c,v 1.2 1998/09/14 18:40:00 stanton Exp $
+ * RCS: @(#) $Id: tclLink.c,v 1.3 1999/04/16 00:46:49 stanton Exp $
*/
#include "tclInt.h"
@@ -74,7 +74,8 @@ static char * StringValue _ANSI_ARGS_((Link *linkPtr,
*
* Results:
* The return value is TCL_OK if everything went well or TCL_ERROR
- * if an error occurred (interp->result is also set after errors).
+ * if an error occurred (the interp's result is also set after
+ * errors).
*
* Side effects:
* The value at *addr is linked to the Tcl variable "varName",
@@ -234,8 +235,8 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
Link *linkPtr = (Link *) clientData;
int changed;
char buffer[TCL_DOUBLE_SPACE];
- char *value, **pp;
- Tcl_DString savedResult;
+ char *value, **pp, *result;
+ Tcl_Obj *objPtr;
/*
* If the variable is being unset, then just re-create it (with a
@@ -315,36 +316,42 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
*/
return "internal error: linked variable couldn't be read";
}
- Tcl_DStringInit(&savedResult);
- Tcl_DStringAppend(&savedResult, interp->result, -1);
+
+ objPtr = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(objPtr);
Tcl_ResetResult(interp);
+ result = NULL;
+
switch (linkPtr->type) {
case TCL_LINK_INT:
if (Tcl_GetInt(interp, value, &linkPtr->lastValue.i) != TCL_OK) {
- Tcl_DStringResult(interp, &savedResult);
+ Tcl_SetObjResult(interp, objPtr);
Tcl_SetVar(interp, linkPtr->varName,
StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY);
- return "variable must have integer value";
+ 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_DStringResult(interp, &savedResult);
+ Tcl_SetObjResult(interp, objPtr);
Tcl_SetVar(interp, linkPtr->varName,
StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY);
- return "variable must have real value";
+ 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_DStringResult(interp, &savedResult);
+ Tcl_SetObjResult(interp, objPtr);
Tcl_SetVar(interp, linkPtr->varName,
StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY);
- return "variable must have boolean value";
+ result = "variable must have boolean value";
+ goto end;
}
*(int *)(linkPtr->addr) = linkPtr->lastValue.i;
break;
@@ -359,8 +366,9 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
default:
return "internal error: bad linked variable type";
}
- Tcl_DStringResult(interp, &savedResult);
- return NULL;
+ end:
+ Tcl_DecrRefCount(objPtr);
+ return result;
}
/*
@@ -372,8 +380,7 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
* 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 string that represents
* the value of the C variable given by linkPtr.
*
* Side effects: