Tcl Source Code

Check-in [39413ccd4f]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Import of TIP 312 implementation
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | tip-312-new
Files: files | file ages | folders
SHA3-256: 39413ccd4f98cb34dc6ea0cb212b94df6fdac252932804168a6b73da8a4811e3
User & Date: dkf 2019-04-03 07:58:17
Context
2019-04-03
09:08
Some fixes. Still broken on 64-bit systems check-in: b81fc362ed user: dkf tags: tip-312-new
07:58
Import of TIP 312 implementation check-in: 39413ccd4f user: dkf tags: tip-312-new
2019-04-02
18:23
merge-mark check-in: 5b3cc9e2a9 user: jan.nijtmans tags: core-8-branch
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to generic/tcl.decls.

  2374   2374   declare 642 {
  2375   2375       void Tcl_DecrRefCount(Tcl_Obj *objPtr)
  2376   2376   }
  2377   2377   
  2378   2378   declare 643 {
  2379   2379       int Tcl_IsShared(Tcl_Obj *objPtr)
  2380   2380   }
         2381  +
         2382  +# TIP#312 New Tcl_LinkArray() function
         2383  +declare 644 {
         2384  +    int Tcl_LinkArray(Tcl_Interp *interp, const char *varName, void *addr,
         2385  +	    int type, int size)
         2386  +}
  2381   2387   
  2382   2388   # ----- BASELINE -- FOR -- 8.7.0 ----- #
  2383   2389   
  2384   2390   ##############################################################################
  2385   2391   
  2386   2392   # Define the platform specific public Tcl interface. These functions are only
  2387   2393   # available on the designated platform.

Changes to generic/tcl.h.

  1089   1089   #define TCL_LINK_ULONG		((sizeof(long) != sizeof(int)) ? TCL_LINK_WIDE_UINT : TCL_LINK_UINT)
  1090   1090   #else
  1091   1091   #define TCL_LINK_LONG		11
  1092   1092   #define TCL_LINK_ULONG		12
  1093   1093   #endif
  1094   1094   #define TCL_LINK_FLOAT		13
  1095   1095   #define TCL_LINK_WIDE_UINT	14
         1096  +#define TCL_LINK_CHARS		15
         1097  +#define TCL_LINK_BINARY		16
  1096   1098   #define TCL_LINK_READ_ONLY	0x80
  1097   1099   
  1098   1100   /*
  1099   1101    *----------------------------------------------------------------------------
  1100   1102    * Forward declarations of Tcl_HashTable and related types.
  1101   1103    */
  1102   1104   

Changes to generic/tclDecls.h.

  1893   1893   EXTERN int		Tcl_HasStringRep(Tcl_Obj *objPtr);
  1894   1894   /* 641 */
  1895   1895   EXTERN void		Tcl_IncrRefCount(Tcl_Obj *objPtr);
  1896   1896   /* 642 */
  1897   1897   EXTERN void		Tcl_DecrRefCount(Tcl_Obj *objPtr);
  1898   1898   /* 643 */
  1899   1899   EXTERN int		Tcl_IsShared(Tcl_Obj *objPtr);
         1900  +/* 644 */
         1901  +EXTERN int		Tcl_LinkArray(Tcl_Interp *interp,
         1902  +				const char *varName, void *addr, int type,
         1903  +				int size);
  1900   1904   
  1901   1905   typedef struct {
  1902   1906       const struct TclPlatStubs *tclPlatStubs;
  1903   1907       const struct TclIntStubs *tclIntStubs;
  1904   1908       const struct TclIntPlatStubs *tclIntPlatStubs;
  1905   1909   } TclStubHooks;
  1906   1910   
................................................................................
  2572   2576       char * (*tcl_InitStringRep) (Tcl_Obj *objPtr, const char *bytes, unsigned int numBytes); /* 637 */
  2573   2577       Tcl_ObjIntRep * (*tcl_FetchIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 638 */
  2574   2578       void (*tcl_StoreIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjIntRep *irPtr); /* 639 */
  2575   2579       int (*tcl_HasStringRep) (Tcl_Obj *objPtr); /* 640 */
  2576   2580       void (*tcl_IncrRefCount) (Tcl_Obj *objPtr); /* 641 */
  2577   2581       void (*tcl_DecrRefCount) (Tcl_Obj *objPtr); /* 642 */
  2578   2582       int (*tcl_IsShared) (Tcl_Obj *objPtr); /* 643 */
         2583  +    int (*tcl_LinkArray) (Tcl_Interp *interp, const char *varName, void *addr, int type, int size); /* 644 */
  2579   2584   } TclStubs;
  2580   2585   
  2581   2586   extern const TclStubs *tclStubsPtr;
  2582   2587   
  2583   2588   #ifdef __cplusplus
  2584   2589   }
  2585   2590   #endif
................................................................................
  3890   3895   	(tclStubsPtr->tcl_HasStringRep) /* 640 */
  3891   3896   #define Tcl_IncrRefCount \
  3892   3897   	(tclStubsPtr->tcl_IncrRefCount) /* 641 */
  3893   3898   #define Tcl_DecrRefCount \
  3894   3899   	(tclStubsPtr->tcl_DecrRefCount) /* 642 */
  3895   3900   #define Tcl_IsShared \
  3896   3901   	(tclStubsPtr->tcl_IsShared) /* 643 */
         3902  +#define Tcl_LinkArray \
         3903  +	(tclStubsPtr->tcl_LinkArray) /* 644 */
  3897   3904   
  3898   3905   #endif /* defined(USE_TCL_STUBS) */
  3899   3906   
  3900   3907   /* !END!: Do not edit above this line. */
  3901   3908   
  3902   3909   #if defined(USE_TCL_STUBS)
  3903   3910   #   undef Tcl_CreateInterp

Changes to generic/tclLink.c.

     4      4    *	This file implements linked variables (a C variable that is tied to a
     5      5    *	Tcl variable). The idea of linked variables was first suggested by
     6      6    *	Andreas Stolcke and this implementation is based heavily on a
     7      7    *	prototype implementation provided by him.
     8      8    *
     9      9    * Copyright (c) 1993 The Regents of the University of California.
    10     10    * Copyright (c) 1994-1997 Sun Microsystems, Inc.
           11  + * Copyright (c) 2008 Rene Zaumseil
    11     12    *
    12     13    * See the file "license.terms" for information on usage and redistribution of
    13     14    * this file, and for a DISCLAIMER OF ALL WARRANTIES.
    14     15    */
    15     16   
    16     17   #include "tclInt.h"
           18  +#include <math.h>
    17     19   
    18     20   /*
    19     21    * For each linked variable there is a data structure of the following type,
    20     22    * which describes the link and is the clientData for the trace set on the Tcl
    21     23    * variable.
    22     24    */
    23     25   
................................................................................
    24     26   typedef struct Link {
    25     27       Tcl_Interp *interp;		/* Interpreter containing Tcl variable. */
    26     28       Tcl_Obj *varName;		/* Name of variable (must be global). This is
    27     29   				 * needed during trace callbacks, since the
    28     30   				 * actual variable may be aliased at that time
    29     31   				 * via upvar. */
    30     32       char *addr;			/* Location of C variable. */
           33  +    int bytes;			/* Size of C variable array. This is 0 when
           34  +				 * single variables, and >0 used for array
           35  +				 * variables */
    31     36       int type;			/* Type of link (TCL_LINK_INT, etc.). */
    32     37       union {
    33     38   	char c;
    34     39   	unsigned char uc;
    35     40   	int i;
    36     41   	unsigned int ui;
    37     42   	short s;
................................................................................
    40     45   	long l;
    41     46   	unsigned long ul;
    42     47   #endif
    43     48   	Tcl_WideInt w;
    44     49   	Tcl_WideUInt uw;
    45     50   	float f;
    46     51   	double d;
           52  +	void *aryPtr;
           53  +	char *pc;
           54  +	unsigned char *puc;
           55  +	int *pi;
           56  +	unsigned int *pui;
           57  +	short *ps;
           58  +	unsigned short *pus;
           59  +	long *pl;
           60  +	unsigned long *pul;
           61  +	Tcl_WideInt *pw;
           62  +	Tcl_WideUInt *puw;
           63  +	float *pf;
           64  +	double *pd;
    47     65       } lastValue;		/* Last known value of C variable; used to
    48     66   				 * avoid string conversions. */
    49     67       int flags;			/* Miscellaneous one-bit values; see below for
    50     68   				 * definitions. */
    51     69   } Link;
    52     70   
    53     71   /*
    54     72    * Definitions for flag bits:
    55     73    * LINK_READ_ONLY -		1 means errors should be generated if Tcl
    56     74    *				script attempts to write variable.
    57     75    * LINK_BEING_UPDATED -		1 means that a call to Tcl_UpdateLinkedVar is
    58     76    *				in progress for this variable, so trace
    59     77    *				callbacks on the variable should be ignored.
           78  + * LINK_ALLOC_ADDR -		1 means linkPtr->addr was allocated on the
           79  + *				heap.
           80  + * LINK_ALLOC_LAST -		1 means linkPtr->valueLast.p was allocated on
           81  + *				the heap.
    60     82    */
    61     83   
    62     84   #define LINK_READ_ONLY		1
    63     85   #define LINK_BEING_UPDATED	2
           86  +#define LINK_ALLOC_ADDR		4
           87  +#define LINK_ALLOC_LAST		8
    64     88   
    65     89   /*
    66     90    * Forward references to functions defined later in this file:
    67     91    */
    68     92   
    69     93   static char *		LinkTraceProc(ClientData clientData,Tcl_Interp *interp,
    70     94   			    const char *name1, const char *name2, int flags);
    71     95   static Tcl_Obj *	ObjValue(Link *linkPtr);
           96  +static void		LinkFree(Link *linkPtr);
    72     97   static int		GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr);
    73         -static int		GetInvalidWideFromObj(Tcl_Obj *objPtr, Tcl_WideInt *widePtr);
    74         -static int		GetInvalidDoubleFromObj(Tcl_Obj *objPtr, double *doublePtr);
           98  +static int		GetInvalidWideFromObj(Tcl_Obj *objPtr,
           99  +			    Tcl_WideInt *widePtr);
          100  +static int		GetInvalidDoubleFromObj(Tcl_Obj *objPtr,
          101  +			    double *doublePtr);
    75    102   
    76    103   /*
    77    104    * Convenience macro for accessing the value of the C variable pointed to by a
    78    105    * link. Note that this macro produces something that may be regarded as an
    79    106    * lvalue or rvalue; it may be assigned to as well as read. Also note that
    80    107    * this macro assumes the name of the variable being accessed (linkPtr); this
    81    108    * is not strictly a good thing, but it keeps the code much shorter and
................................................................................
   140    167       }
   141    168   #endif
   142    169       if (type & TCL_LINK_READ_ONLY) {
   143    170   	linkPtr->flags = LINK_READ_ONLY;
   144    171       } else {
   145    172   	linkPtr->flags = 0;
   146    173       }
          174  +    linkPtr->bytes = 0;
          175  +    objPtr = ObjValue(linkPtr);
          176  +    if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
          177  +	    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
          178  +	Tcl_DecrRefCount(linkPtr->varName);
          179  +	LinkFree(linkPtr);
          180  +	return TCL_ERROR;
          181  +    }
          182  +    code = Tcl_TraceVar2(interp, varName, NULL,
          183  +	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
          184  +	    LinkTraceProc, linkPtr);
          185  +    if (code != TCL_OK) {
          186  +	Tcl_DecrRefCount(linkPtr->varName);
          187  +	LinkFree(linkPtr);
          188  +    }
          189  +    return code;
          190  +}
          191  +
          192  +/*
          193  + *----------------------------------------------------------------------
          194  + *
          195  + * Tcl_LinkArray --
          196  + *
          197  + *	Link a C variable array to a Tcl variable so that changes to either
          198  + *	one causes the other to change.
          199  + *
          200  + * Results:
          201  + *	The return value is TCL_OK if everything went well or TCL_ERROR if an
          202  + *	error occurred (the interp's result is also set after errors).
          203  + *
          204  + * Side effects:
          205  + *	The value at *addr is linked to the Tcl variable "varName", using
          206  + *	"type" to convert between string values for Tcl and binary values for
          207  + *	*addr.
          208  + *
          209  + *----------------------------------------------------------------------
          210  + */
          211  +
          212  +int
          213  +Tcl_LinkArray(
          214  +    Tcl_Interp *interp,		/* Interpreter in which varName exists. */
          215  +    const char *varName,	/* Name of a global variable in interp. */
          216  +    void *addr,			/* Address of a C variable to be linked to
          217  +				 * varName. If NULL then the necessary space
          218  +				 * will be allocated and returned as the
          219  +				 * interpreter result. */
          220  +    int type,			/* Type of C variable: TCL_LINK_INT, etc. Also
          221  +				 * may have TCL_LINK_READ_ONLY and
          222  +				 * TCL_LINK_ALLOC OR'ed in. */
          223  +    int size)			/* Size of C variable array, >1 if array */
          224  +{
          225  +    Tcl_Obj *objPtr;
          226  +    Link *linkPtr;
          227  +    int code;
          228  +
          229  +    if (size < 1) {
          230  +	Tcl_SetObjResult(interp, Tcl_NewStringObj(
          231  +		"wrong array size given", -1));
          232  +	return TCL_ERROR;
          233  +    }
          234  +
          235  +    linkPtr = ckalloc(sizeof(Link));
          236  +    linkPtr->type = type & ~TCL_LINK_READ_ONLY;
          237  +    if (type & TCL_LINK_READ_ONLY) {
          238  +	linkPtr->flags = LINK_READ_ONLY;
          239  +    } else {
          240  +	linkPtr->flags = 0;
          241  +    }
          242  +
          243  +    switch (linkPtr->type) {
          244  +    case TCL_LINK_INT:
          245  +    case TCL_LINK_BOOLEAN:
          246  +	linkPtr->bytes = size * sizeof(int);
          247  +	break;
          248  +    case TCL_LINK_DOUBLE:
          249  +	linkPtr->bytes = size * sizeof(double);
          250  +	break;
          251  +    case TCL_LINK_WIDE_INT:
          252  +	linkPtr->bytes = size * sizeof(Tcl_WideInt);
          253  +	break;
          254  +    case TCL_LINK_WIDE_UINT:
          255  +	linkPtr->bytes = size * sizeof(Tcl_WideUInt);
          256  +	break;
          257  +    case TCL_LINK_CHAR:
          258  +	linkPtr->bytes = size * sizeof(char);
          259  +	break;
          260  +    case TCL_LINK_UCHAR:
          261  +	linkPtr->bytes = size * sizeof(unsigned char);
          262  +	break;
          263  +    case TCL_LINK_SHORT:
          264  +	linkPtr->bytes = size * sizeof(short);
          265  +	break;
          266  +    case TCL_LINK_USHORT:
          267  +	linkPtr->bytes = size * sizeof(unsigned short);
          268  +	break;
          269  +    case TCL_LINK_UINT:
          270  +	linkPtr->bytes = size * sizeof(unsigned int);
          271  +	break;
          272  +#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
          273  +    case TCL_LINK_LONG:
          274  +	linkPtr->bytes = size * sizeof(long);
          275  +	break;
          276  +    case TCL_LINK_ULONG:
          277  +	linkPtr->bytes = size * sizeof(unsigned long);
          278  +	break;
          279  +#endif
          280  +    case TCL_LINK_FLOAT:
          281  +	linkPtr->bytes = size * sizeof(float);
          282  +	break;
          283  +    case TCL_LINK_STRING:
          284  +	linkPtr->bytes = size * sizeof(char);
          285  +	size = 1;		/* This is a variable length string, no need
          286  +				 * to check last value. */
          287  +
          288  +	/*
          289  +	 * If no address is given create one and use as address the
          290  +         * not needed linkPtr->lastValue
          291  +	 */
          292  +
          293  +	if (addr == NULL) {
          294  +	    linkPtr->lastValue.aryPtr = ckalloc(linkPtr->bytes);
          295  +	    linkPtr->flags |= LINK_ALLOC_LAST;
          296  +	    addr = (char *) &linkPtr->lastValue.pc;
          297  +	}
          298  +	break;
          299  +    case TCL_LINK_CHARS:
          300  +    case TCL_LINK_BINARY:
          301  +	linkPtr->bytes = size * sizeof(char);
          302  +	break;
          303  +    default:
          304  +	LinkFree(linkPtr);
          305  +	Tcl_SetObjResult(interp, Tcl_NewStringObj(
          306  +		"bad linked array variable type", -1));
          307  +	return TCL_ERROR;
          308  +    }
          309  +
          310  +    /*
          311  +     * Allocate C variable space in case no address is given
          312  +     */
          313  +
          314  +    if (addr == NULL) {
          315  +	linkPtr->addr = ckalloc(linkPtr->bytes);
          316  +	linkPtr->flags |= LINK_ALLOC_ADDR;
          317  +    } else {
          318  +	linkPtr->addr = addr;
          319  +    }
          320  +
          321  +    /*
          322  +     * If necessary create space for last used value.
          323  +     */
          324  +
          325  +    if (size > 1) {
          326  +	linkPtr->lastValue.aryPtr = ckalloc(linkPtr->bytes);
          327  +	linkPtr->flags |= LINK_ALLOC_LAST;
          328  +    }
          329  +
          330  +    /*
          331  +     * Set common structure values.
          332  +     */
          333  +
          334  +    linkPtr->interp = interp;
          335  +    linkPtr->varName = Tcl_NewStringObj(varName, -1);
          336  +    Tcl_IncrRefCount(linkPtr->varName);
   147    337       objPtr = ObjValue(linkPtr);
   148    338       if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
   149    339   	    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
   150    340   	Tcl_DecrRefCount(linkPtr->varName);
   151         -	ckfree(linkPtr);
          341  +	LinkFree(linkPtr);
   152    342   	return TCL_ERROR;
   153    343       }
          344  +
   154    345       code = Tcl_TraceVar2(interp, varName, NULL,
   155    346   	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
   156    347   	    LinkTraceProc, linkPtr);
   157    348       if (code != TCL_OK) {
   158    349   	Tcl_DecrRefCount(linkPtr->varName);
   159         -	ckfree(linkPtr);
          350  +	LinkFree(linkPtr);
          351  +    } else {
          352  +	Tcl_SetObjResult(interp, Tcl_NewIntObj((int) linkPtr->addr));
   160    353       }
   161    354       return code;
   162    355   }
   163    356   
   164    357   /*
   165    358    *----------------------------------------------------------------------
   166    359    *
................................................................................
   190    383       if (linkPtr == NULL) {
   191    384   	return;
   192    385       }
   193    386       Tcl_UntraceVar2(interp, varName, NULL,
   194    387   	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
   195    388   	    LinkTraceProc, linkPtr);
   196    389       Tcl_DecrRefCount(linkPtr->varName);
   197         -    ckfree(linkPtr);
          390  +    LinkFree(linkPtr);
   198    391   }
   199    392   
   200    393   /*
   201    394    *----------------------------------------------------------------------
   202    395    *
   203    396    * Tcl_UpdateLinkedVar --
   204    397    *
................................................................................
   237    430        */
   238    431       linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL,
   239    432   	    TCL_GLOBAL_ONLY, LinkTraceProc, NULL);
   240    433       if (linkPtr != NULL) {
   241    434   	linkPtr->flags = (linkPtr->flags & ~LINK_BEING_UPDATED) | savedFlag;
   242    435       }
   243    436   }
          437  +
          438  +static inline int
          439  +GetInt(
          440  +    Tcl_Obj *objPtr,
          441  +    int *intPtr)
          442  +{
          443  +    return (Tcl_GetIntFromObj(NULL, objPtr, intPtr) != TCL_OK
          444  +	    && GetInvalidIntFromObj(objPtr, intPtr) != TCL_OK);
          445  +}
          446  +
          447  +static inline int
          448  +GetWide(
          449  +    Tcl_Obj *objPtr,
          450  +    Tcl_WideInt *widePtr)
          451  +{
          452  +    return (Tcl_GetWideIntFromObj(NULL, objPtr, widePtr) != TCL_OK
          453  +	    && GetInvalidWideFromObj(objPtr, widePtr) != TCL_OK);
          454  +}
          455  +
          456  +static inline int
          457  +GetDouble(
          458  +    Tcl_Obj *objPtr,
          459  +    double *dblPtr)
          460  +{
          461  +    if (Tcl_GetDoubleFromObj(NULL, objPtr, dblPtr) == TCL_OK) {
          462  +	return 0;
          463  +    } else {
          464  +#ifdef ACCEPT_NAN
          465  +	Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &tclDoubleType);
          466  +
          467  +	if (irPtr != NULL) {
          468  +	    *dblPtr = irPtr->doubleValue;
          469  +	    return 0;
          470  +	}
          471  +#endif
          472  +	return GetInvalidDoubleFromObj(objPtr, dblPtr) != TCL_OK;
          473  +    }
          474  +}
   244    475   
   245    476   /*
   246    477    *----------------------------------------------------------------------
   247    478    *
   248    479    * LinkTraceProc --
   249    480    *
   250    481    *	This function is invoked when a linked Tcl variable is read, written,
................................................................................
   269    500       Tcl_Interp *interp,		/* Interpreter containing Tcl variable. */
   270    501       const char *name1,		/* First part of variable name. */
   271    502       const char *name2,		/* Second part of variable name. */
   272    503       int flags)			/* Miscellaneous additional information. */
   273    504   {
   274    505       Link *linkPtr = clientData;
   275    506       int changed;
   276         -    size_t valueLength;
          507  +    int valueLength;
   277    508       const char *value;
   278    509       char **pp;
   279    510       Tcl_Obj *valueObj;
   280    511       int valueInt;
   281    512       Tcl_WideInt valueWide;
   282    513       double valueDouble;
          514  +    int objc;
          515  +    Tcl_Obj **objv;
          516  +    int i;
   283    517   
   284    518       /*
   285    519        * If the variable is being unset, then just re-create it (with a trace)
   286    520        * unless the whole interpreter is going away.
   287    521        */
   288    522   
   289    523       if (flags & TCL_TRACE_UNSETS) {
   290    524   	if (Tcl_InterpDeleted(interp)) {
   291    525   	    Tcl_DecrRefCount(linkPtr->varName);
   292         -	    ckfree(linkPtr);
          526  +	    LinkFree(linkPtr);
   293    527   	} else if (flags & TCL_TRACE_DESTROYED) {
   294    528   	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
   295    529   		    TCL_GLOBAL_ONLY);
   296    530   	    Tcl_TraceVar2(interp, Tcl_GetString(linkPtr->varName), NULL,
   297    531   		    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
   298    532   		    |TCL_TRACE_UNSETS, LinkTraceProc, linkPtr);
   299    533   	}
................................................................................
   312    546   
   313    547       /*
   314    548        * For read accesses, update the Tcl variable if the C variable has
   315    549        * changed since the last time we updated the Tcl variable.
   316    550        */
   317    551   
   318    552       if (flags & TCL_TRACE_READS) {
   319         -	switch (linkPtr->type) {
   320         -	case TCL_LINK_INT:
   321         -	case TCL_LINK_BOOLEAN:
   322         -	    changed = (LinkedVar(int) != linkPtr->lastValue.i);
   323         -	    break;
   324         -	case TCL_LINK_DOUBLE:
   325         -	    changed = (LinkedVar(double) != linkPtr->lastValue.d);
   326         -	    break;
   327         -	case TCL_LINK_WIDE_INT:
   328         -	    changed = (LinkedVar(Tcl_WideInt) != linkPtr->lastValue.w);
   329         -	    break;
   330         -	case TCL_LINK_WIDE_UINT:
   331         -	    changed = (LinkedVar(Tcl_WideUInt) != linkPtr->lastValue.uw);
   332         -	    break;
   333         -	case TCL_LINK_CHAR:
   334         -	    changed = (LinkedVar(char) != linkPtr->lastValue.c);
   335         -	    break;
   336         -	case TCL_LINK_UCHAR:
   337         -	    changed = (LinkedVar(unsigned char) != linkPtr->lastValue.uc);
   338         -	    break;
   339         -	case TCL_LINK_SHORT:
   340         -	    changed = (LinkedVar(short) != linkPtr->lastValue.s);
   341         -	    break;
   342         -	case TCL_LINK_USHORT:
   343         -	    changed = (LinkedVar(unsigned short) != linkPtr->lastValue.us);
   344         -	    break;
   345         -	case TCL_LINK_UINT:
   346         -	    changed = (LinkedVar(unsigned int) != linkPtr->lastValue.ui);
   347         -	    break;
          553  +	/*
          554  +	 * Variable arrays
          555  +	 */
          556  +
          557  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
          558  +	    changed = memcmp(linkPtr->addr, linkPtr->lastValue.aryPtr,
          559  +		    linkPtr->bytes);
          560  +	} else {
          561  +	    /* single variables */
          562  +	    switch (linkPtr->type) {
          563  +	    case TCL_LINK_INT:
          564  +	    case TCL_LINK_BOOLEAN:
          565  +		changed = (LinkedVar(int) != linkPtr->lastValue.i);
          566  +		break;
          567  +	    case TCL_LINK_DOUBLE:
          568  +		changed = (LinkedVar(double) != linkPtr->lastValue.d);
          569  +		break;
          570  +	    case TCL_LINK_WIDE_INT:
          571  +		changed = (LinkedVar(Tcl_WideInt) != linkPtr->lastValue.w);
          572  +		break;
          573  +	    case TCL_LINK_WIDE_UINT:
          574  +		changed = (LinkedVar(Tcl_WideUInt) != linkPtr->lastValue.uw);
          575  +		break;
          576  +	    case TCL_LINK_CHAR:
          577  +		changed = (LinkedVar(char) != linkPtr->lastValue.c);
          578  +		break;
          579  +	    case TCL_LINK_UCHAR:
          580  +		changed = (LinkedVar(unsigned char) != linkPtr->lastValue.uc);
          581  +		break;
          582  +	    case TCL_LINK_SHORT:
          583  +		changed = (LinkedVar(short) != linkPtr->lastValue.s);
          584  +		break;
          585  +	    case TCL_LINK_USHORT:
          586  +		changed = (LinkedVar(unsigned short) != linkPtr->lastValue.us);
          587  +		break;
          588  +	    case TCL_LINK_UINT:
          589  +		changed = (LinkedVar(unsigned int) != linkPtr->lastValue.ui);
          590  +		break;
   348    591   #if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
   349         -	case TCL_LINK_LONG:
   350         -	    changed = (LinkedVar(long) != linkPtr->lastValue.l);
   351         -	    break;
   352         -	case TCL_LINK_ULONG:
   353         -	    changed = (LinkedVar(unsigned long) != linkPtr->lastValue.ul);
   354         -	    break;
          592  +	    case TCL_LINK_LONG:
          593  +		changed = (LinkedVar(long) != linkPtr->lastValue.l);
          594  +		break;
          595  +	    case TCL_LINK_ULONG:
          596  +		changed = (LinkedVar(unsigned long) != linkPtr->lastValue.ul);
          597  +		break;
   355    598   #endif
   356         -	case TCL_LINK_FLOAT:
   357         -	    changed = (LinkedVar(float) != linkPtr->lastValue.f);
   358         -	    break;
   359         -	case TCL_LINK_STRING:
   360         -	    changed = 1;
   361         -	    break;
   362         -	default:
   363         -	    return (char *) "internal error: bad linked variable type";
          599  +	    case TCL_LINK_FLOAT:
          600  +		changed = (LinkedVar(float) != linkPtr->lastValue.f);
          601  +		break;
          602  +	    case TCL_LINK_STRING:
          603  +	    case TCL_LINK_CHARS:
          604  +	    case TCL_LINK_BINARY:
          605  +		changed = 1;
          606  +		break;
          607  +	    default:
          608  +		changed = 0;
          609  +		/* return (char *) "internal error: bad linked variable type"; */
          610  +	    }
   364    611   	}
   365    612   	if (changed) {
   366    613   	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
   367    614   		    TCL_GLOBAL_ONLY);
   368    615   	}
   369    616   	return NULL;
   370    617       }
................................................................................
   388    635   	/*
   389    636   	 * This shouldn't ever happen.
   390    637   	 */
   391    638   
   392    639   	return (char *) "internal error: linked variable couldn't be read";
   393    640       }
   394    641   
          642  +    /*
          643  +     * A couple of helper macros. 
          644  +     */
          645  +
          646  +#define CheckHaveList(valueObj, underlyingType)				\
          647  +    if (Tcl_ListObjGetElements(NULL, (valueObj), &objc, &objv) == TCL_ERROR \
          648  +	    || objc != linkPtr->bytes / sizeof(underlyingType)) { \
          649  +	return (char *) "wrong dimension";			  \
          650  +    }
          651  +#define InRange(lowerLimit, value, upperLimit)	\
          652  +    ((value) >= (lowerLimit) && (value) <= (upperLimit))
          653  +
   395    654       switch (linkPtr->type) {
   396    655       case TCL_LINK_INT:
   397         -	if (Tcl_GetIntFromObj(NULL, valueObj, &linkPtr->lastValue.i) != TCL_OK
   398         -		&& GetInvalidIntFromObj(valueObj, &linkPtr->lastValue.i) != TCL_OK) {
   399         -	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
   400         -		    TCL_GLOBAL_ONLY);
   401         -	    return (char *) "variable must have integer value";
          656  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
          657  +	    CheckHaveList(valueObj, int);
          658  +	    for (i=0; i < objc; i++) {
          659  +		int *varPtr = &linkPtr->lastValue.pi[i];
          660  +
          661  +		if (GetInt(objv[i], varPtr)) {
          662  +		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
          663  +			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
          664  +	            return (char *) "variable array must have integer values";
          665  +		}
          666  +	    }
          667  +	    memcpy(linkPtr->addr, linkPtr->lastValue.aryPtr, linkPtr->bytes);
          668  +	} else {
          669  +	    int *varPtr = &linkPtr->lastValue.i;
          670  +
          671  +	    if (GetInt(valueObj, varPtr)) {
          672  +		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
          673  +			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
          674  +		return (char *) "variable must have integer value";
          675  +	    }
          676  +	    LinkedVar(int) = *varPtr;
   402    677   	}
   403         -	LinkedVar(int) = linkPtr->lastValue.i;
   404    678   	break;
   405    679   
   406    680       case TCL_LINK_WIDE_INT:
   407         -	if (Tcl_GetWideIntFromObj(NULL, valueObj, &linkPtr->lastValue.w) != TCL_OK
   408         -		&& GetInvalidWideFromObj(valueObj, &linkPtr->lastValue.w) != TCL_OK) {
   409         -	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
   410         -		    TCL_GLOBAL_ONLY);
   411         -	    return (char *) "variable must have integer value";
          681  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
          682  +	    CheckHaveList(valueObj, Tcl_WideInt);
          683  +	    for (i=0; i < objc; i++) {
          684  +		Tcl_WideInt *varPtr = &linkPtr->lastValue.pw[i];
          685  +
          686  +		if (GetWide(objv[i], varPtr)) {
          687  +		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
          688  +			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
          689  +		    return (char *)
          690  +			    "variable array must have wide integer value";
          691  +		}
          692  +	    }
          693  +	    memcpy(linkPtr->addr, linkPtr->lastValue.aryPtr, linkPtr->bytes);
          694  +	} else {
          695  +	    Tcl_WideInt *varPtr = &linkPtr->lastValue.w;
          696  +
          697  +	    if (GetWide(valueObj, varPtr)) {
          698  +		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
          699  +			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
          700  +		return (char *) "variable must have wide integer value";
          701  +	    }
          702  +	    LinkedVar(Tcl_WideInt) = *varPtr;
   412    703   	}
   413         -	LinkedVar(Tcl_WideInt) = linkPtr->lastValue.w;
   414    704   	break;
   415    705   
   416    706       case TCL_LINK_DOUBLE:
   417         -	if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d) != TCL_OK) {
   418         -#ifdef ACCEPT_NAN
   419         -	    Tcl_ObjIntRep *irPtr = TclFetchIntRep(valueObj, &tclDoubleType);
   420         -	    if (irPtr == NULL) {
   421         -#endif
   422         -		if (GetInvalidDoubleFromObj(valueObj, &linkPtr->lastValue.d) != TCL_OK) {
   423         -		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
   424         -			TCL_GLOBAL_ONLY);
   425         -		    return (char *) "variable must have real value";
          707  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
          708  +	    CheckHaveList(valueObj, double);
          709  +	    for (i=0; i < objc; i++) {
          710  +		if (GetDouble(objv[i], &linkPtr->lastValue.pd[i])) {
          711  +		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
          712  +			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
          713  +		    return (char *) "variable array must have real value";
   426    714   		}
   427         -#ifdef ACCEPT_NAN
   428    715   	    }
   429         -	    linkPtr->lastValue.d = irPtr->doubleValue;
   430         -#endif
          716  +	    memcpy(linkPtr->addr, linkPtr->lastValue.aryPtr, linkPtr->bytes);
          717  +	} else {
          718  +	    double *varPtr = &linkPtr->lastValue.d;
          719  +
          720  +	    if (GetDouble(valueObj, varPtr)) {
          721  +		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
          722  +			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
          723  +		return (char *) "variable must have real value";
          724  +	    }
          725  +	    LinkedVar(double) = *varPtr;
   431    726   	}
   432         -	LinkedVar(double) = linkPtr->lastValue.d;
   433    727   	break;
   434    728   
   435    729       case TCL_LINK_BOOLEAN:
   436         -	if (Tcl_GetBooleanFromObj(NULL, valueObj, &linkPtr->lastValue.i) != TCL_OK) {
   437         -	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
   438         -		    TCL_GLOBAL_ONLY);
   439         -	    return (char *) "variable must have boolean value";
          730  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
          731  +	    CheckHaveList(valueObj, int);
          732  +	    for (i=0; i < objc; i++) {
          733  +		int *varPtr = &linkPtr->lastValue.pi[i];
          734  +
          735  +		if (Tcl_GetBooleanFromObj(NULL, objv[i], varPtr) != TCL_OK) {
          736  +		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
          737  +			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
          738  +	            return (char *) "variable array must have boolean value";
          739  +		}
          740  +	    }
          741  +	    memcpy(linkPtr->addr, linkPtr->lastValue.aryPtr, linkPtr->bytes);
          742  +	} else {
          743  +	    int *varPtr = &linkPtr->lastValue.i;
          744  +
          745  +	    if (Tcl_GetBooleanFromObj(NULL, valueObj, varPtr) != TCL_OK) {
          746  +		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
          747  +			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
          748  +		return (char *) "variable must have boolean value";
          749  +	    }
          750  +	    LinkedVar(int) = *varPtr;
   440    751   	}
   441         -	LinkedVar(int) = linkPtr->lastValue.i;
   442    752   	break;
   443    753   
   444    754       case TCL_LINK_CHAR:
   445         -	if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
   446         -		&& GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK)
   447         -		|| valueInt < SCHAR_MIN || valueInt > SCHAR_MAX) {
   448         -	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
   449         -		    TCL_GLOBAL_ONLY);
   450         -	    return (char *) "variable must have char value";
          755  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
          756  +	    CheckHaveList(valueObj, char);
          757  +	    for (i=0; i < objc; i++) {
          758  +		if (GetInt(objv[i], &valueInt)
          759  +		        || !InRange(SCHAR_MIN, valueInt, SCHAR_MAX)) {
          760  +		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
          761  +			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
          762  +	            return (char *) "variable array must have char value";
          763  +		}
          764  +		linkPtr->lastValue.pc[i] = (char) valueInt;
          765  +	    }
          766  +	    memcpy(linkPtr->addr, linkPtr->lastValue.aryPtr, linkPtr->bytes);
          767  +	    break;
          768  +	} else {
          769  +	    if (GetInt(valueObj, &valueInt)
          770  +		    || !InRange(SCHAR_MIN, valueInt, SCHAR_MAX)) {
          771  +		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
          772  +			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
          773  +		return (char *) "variable must have char value";
          774  +	    }
          775  +	    LinkedVar(char) = linkPtr->lastValue.c = (char) valueInt;
   451    776   	}
   452         -	LinkedVar(char) = linkPtr->lastValue.c = (char)valueInt;
   453    777   	break;
   454    778   
   455    779       case TCL_LINK_UCHAR:
   456         -	if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
   457         -		&& GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK)
   458         -		|| valueInt < 0 || valueInt > UCHAR_MAX) {
   459         -	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
   460         -		    TCL_GLOBAL_ONLY);
   461         -	    return (char *) "variable must have unsigned char value";
          780  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
          781  +	    CheckHaveList(valueObj, unsigned char);
          782  +	    for (i=0; i < objc; i++) {
          783  +		if (GetInt(objv[i], &valueInt)
          784  +		        || !InRange(0, valueInt, UCHAR_MAX)) {
          785  +		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
          786  +			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
          787  +		    return (char *)
          788  +			    "variable array must have unsigned char value";
          789  +		}
          790  +		linkPtr->lastValue.puc[i] = (unsigned char) valueInt;
          791  +	    }
          792  +	    memcpy(linkPtr->addr, linkPtr->lastValue.aryPtr, linkPtr->bytes);
          793  +	} else {
          794  +	    if (GetInt(valueObj, &valueInt)
          795  +		    || !InRange(0, valueInt, UCHAR_MAX)) {
          796  +		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
          797  +			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
          798  +		return (char *) "variable must have unsigned char value";
          799  +	    }
          800  +	    LinkedVar(unsigned char) = linkPtr->lastValue.uc =
          801  +		    (unsigned char) valueInt;
   462    802   	}
   463         -	LinkedVar(unsigned char) = linkPtr->lastValue.uc = (unsigned char) valueInt;
   464    803   	break;
   465    804   
   466    805       case TCL_LINK_SHORT:
   467         -	if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
   468         -		&& GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK)
   469         -		|| valueInt < SHRT_MIN || valueInt > SHRT_MAX) {
   470         -	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
   471         -		    TCL_GLOBAL_ONLY);
   472         -	    return (char *) "variable must have short value";
          806  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
          807  +	    CheckHaveList(valueObj, short);
          808  +	    for (i=0; i < objc; i++) {
          809  +		if (GetInt(objv[i], &valueInt)
          810  +			|| !InRange(SHRT_MIN, valueInt, SHRT_MAX)) {
          811  +		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
          812  +			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
          813  +	            return (char *) "variable array must have short value";
          814  +		}
          815  +		linkPtr->lastValue.ps[i] = (short) valueInt;
          816  +	    }
          817  +	    memcpy(linkPtr->addr, linkPtr->lastValue.aryPtr, linkPtr->bytes);
          818  +	} else {
          819  +	    if (GetInt(valueObj, &valueInt)
          820  +		    || !InRange(SHRT_MIN, valueInt, SHRT_MAX)) {
          821  +		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
          822  +			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
          823  +		return (char *) "variable must have short value";
          824  +	    }
          825  +	    LinkedVar(short) = linkPtr->lastValue.s = (short) valueInt;
   473    826   	}
   474         -	LinkedVar(short) = linkPtr->lastValue.s = (short)valueInt;
   475    827   	break;
   476    828   
   477    829       case TCL_LINK_USHORT:
   478         -	if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
   479         -		&& GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK)
   480         -		|| valueInt < 0 || valueInt > USHRT_MAX) {
   481         -	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
   482         -		    TCL_GLOBAL_ONLY);
   483         -	    return (char *) "variable must have unsigned short value";
          830  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
          831  +	    CheckHaveList(valueObj, unsigned short);
          832  +	    for (i=0; i < objc; i++) {
          833  +		if (GetInt(objv[i], &valueInt)
          834  +		        || !InRange(0, valueInt, USHRT_MAX)) {
          835  +		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
          836  +			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
          837  +	            return (char *)
          838  +			"variable array must have unsigned short value";
          839  +		}
          840  +		linkPtr->lastValue.pus[i] = (unsigned short) valueInt;
          841  +	    }
          842  +	    memcpy(linkPtr->addr, linkPtr->lastValue.aryPtr, linkPtr->bytes);
          843  +	} else {
          844  +	    if (GetInt(valueObj, &valueInt)
          845  +		    || !InRange(0, valueInt, USHRT_MAX)) {
          846  +		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
          847  +			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
          848  +		return (char *) "variable must have unsigned short value";
          849  +	    }
          850  +	    LinkedVar(unsigned short) = linkPtr->lastValue.us =
          851  +		    (unsigned short) valueInt;
   484    852   	}
   485         -	LinkedVar(unsigned short) = linkPtr->lastValue.us = (unsigned short)valueInt;
   486    853   	break;
   487    854   
   488    855       case TCL_LINK_UINT:
   489         -	if ((Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
   490         -		&& GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK)
   491         -		|| valueWide < 0 || valueWide > UINT_MAX) {
   492         -	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
   493         -		    TCL_GLOBAL_ONLY);
   494         -	    return (char *) "variable must have unsigned int value";
          856  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
          857  +	    CheckHaveList(valueObj, unsigned int);
          858  +	    for (i=0; i < objc; i++) {
          859  +		if (GetWide(objv[i], &valueWide)
          860  +			|| !InRange(0, valueWide, UINT_MAX)) {
          861  +		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
          862  +			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
          863  +	            return (char *)
          864  +			    "variable array must have unsigned int value";
          865  +		}
          866  +		linkPtr->lastValue.pui[i] = (unsigned int) valueWide;
          867  +	    }
          868  +	    memcpy(linkPtr->addr, linkPtr->lastValue.aryPtr, linkPtr->bytes);
          869  +	} else {
          870  +	    if (GetWide(valueObj, &valueWide)
          871  +		    || !InRange(0, valueWide, UINT_MAX)) {
          872  +		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
          873  +			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
          874  +		return (char *) "variable must have unsigned int value";
          875  +	    }
          876  +	    LinkedVar(unsigned int) = linkPtr->lastValue.ui =
          877  +		    (unsigned int) valueWide;
   495    878   	}
   496         -	LinkedVar(unsigned int) = linkPtr->lastValue.ui = (unsigned int)valueWide;
   497    879   	break;
   498    880   
   499    881   #if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
   500    882       case TCL_LINK_LONG:
   501         -	if ((Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
   502         -		&& GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK)
   503         -		|| valueWide < LONG_MIN || valueWide > LONG_MAX) {
   504         -	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
   505         -		    TCL_GLOBAL_ONLY);
   506         -	    return (char *) "variable must have long value";
          883  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
          884  +	    CheckHaveList(valueObj, long);
          885  +	    for (i=0; i < objc; i++) {
          886  +		if (GetWide(objv[i], &valueWide)
          887  +			|| !InRange(LONG_MIN, valueWide, LONG_MAX)) {
          888  +		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
          889  +			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
          890  +	            return (char *) "variable array must have long value";
          891  +		}
          892  +		linkPtr->lastValue.pl[i] = (long) valueWide;
          893  +	    }
          894  +	    memcpy(linkPtr->addr, linkPtr->lastValue.aryPtr, linkPtr->bytes);
          895  +	    break;
          896  +	} else {
          897  +	    if (GetWide(valueObj, &valueWide)
          898  +		    || !InRange(LONG_MIN, valueWide, LONG_MAX)) {
          899  +		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
          900  +			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
          901  +		return (char *) "variable must have long value";
          902  +	    }
          903  +	    LinkedVar(long) = linkPtr->lastValue.l = (long) valueWide;
   507    904   	}
   508         -	LinkedVar(long) = linkPtr->lastValue.l = (long)valueWide;
   509    905   	break;
   510    906   
   511    907       case TCL_LINK_ULONG:
   512         -	if ((Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
   513         -		&& GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK)
   514         -		|| valueWide < 0 || (Tcl_WideUInt) valueWide > ULONG_MAX) {
   515         -	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
   516         -		    TCL_GLOBAL_ONLY);
   517         -	    return (char *) "variable must have unsigned long value";
          908  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
          909  +	    CheckHaveList(valueObj, unsigned long);
          910  +	    for (i=0; i < objc; i++) {
          911  +		if (GetWide(objv[i], &valueWide)
          912  +			|| !InRange(0, valueWide, ULONG_MAX)) {
          913  +		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
          914  +			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
          915  +	            return (char *)
          916  +			    "variable array must have unsigned long value";
          917  +		}
          918  +		linkPtr->lastValue.pul[i] = (unsigned long) valueWide;
          919  +	    }
          920  +	    memcpy(linkPtr->addr, linkPtr->lastValue.aryPtr, linkPtr->bytes);
          921  +	} else {
          922  +	    if (GetWide(valueObj, &valueWide)
          923  +		    || !InRange(0, valueWide, ULONG_MAX)) {
          924  +		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
          925  +			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
          926  +		return (char *) "variable must have unsigned long value";
          927  +	    }
          928  +	    LinkedVar(unsigned long) = linkPtr->lastValue.ul =
          929  +		    (unsigned long) valueWide;
   518    930   	}
   519         -	LinkedVar(unsigned long) = linkPtr->lastValue.ul = (unsigned long)valueWide;
   520    931   	break;
   521    932   #endif
   522    933   
   523    934       case TCL_LINK_WIDE_UINT:
   524    935   	/*
   525    936   	 * FIXME: represent as a bignum.
   526    937   	 */
   527         -	if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
   528         -		&& GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK) {
   529         -	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
   530         -		    TCL_GLOBAL_ONLY);
   531         -	    return (char *) "variable must have unsigned wide int value";
          938  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
          939  +	    CheckHaveList(valueObj, Tcl_WideUInt);
          940  +	    for (i=0; i < objc; i++) {
          941  +		if (GetWide(objv[i], &valueWide)) {
          942  +		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
          943  +			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
          944  +	            return (char *)
          945  +			    "variable array must have unsigned wide int value";
          946  +		}
          947  +		linkPtr->lastValue.puw[i] = (Tcl_WideUInt) valueWide;
          948  +	    }
          949  +	    memcpy(linkPtr->addr, linkPtr->lastValue.aryPtr, linkPtr->bytes);
          950  +	} else {
          951  +	    if (GetWide(valueObj, &valueWide)) {
          952  +		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
          953  +			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
          954  +		return (char *) "variable must have unsigned wide int value";
          955  +	    }
          956  +	    LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw =
          957  +		    (Tcl_WideUInt) valueWide;
   532    958   	}
   533         -	LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw = (Tcl_WideUInt)valueWide;
   534    959   	break;
   535    960   
   536    961       case TCL_LINK_FLOAT:
   537         -	if ((Tcl_GetDoubleFromObj(NULL, valueObj, &valueDouble) != TCL_OK
   538         -		&& GetInvalidDoubleFromObj(valueObj, &valueDouble) != TCL_OK)
   539         -		|| valueDouble < -FLT_MAX || valueDouble > FLT_MAX) {
   540         -	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
   541         -		    TCL_GLOBAL_ONLY);
   542         -	    return (char *) "variable must have float value";
          962  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
          963  +	    CheckHaveList(valueObj, float);
          964  +	    for (i=0; i < objc; i++) {
          965  +		if (GetDouble(objv[i], &valueDouble)
          966  +			&& !InRange(FLT_MIN, valueDouble, FLT_MAX)
          967  +		        && !TclIsInfinite(valueDouble)
          968  +			&& !TclIsNaN(valueDouble)) {
          969  +		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
          970  +			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
          971  +	            return (char *) "variable array must have float value";
          972  +		}
          973  +		linkPtr->lastValue.pf[i] = (float) valueDouble;
          974  +	    }
          975  +	    memcpy(linkPtr->addr, linkPtr->lastValue.aryPtr, linkPtr->bytes);
          976  +	} else {
          977  +	    if (GetDouble(valueObj, &valueDouble)
          978  +		    && !InRange(FLT_MIN, valueDouble, FLT_MAX)
          979  +		    && !TclIsInfinite(valueDouble) && !TclIsNaN(valueDouble)) {
          980  +		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
          981  +			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
          982  +		return (char *) "variable must have float value";
          983  +	    }
          984  +	    LinkedVar(float) = linkPtr->lastValue.f = (float) valueDouble;
   543    985   	}
   544         -	LinkedVar(float) = linkPtr->lastValue.f = (float)valueDouble;
   545    986   	break;
   546    987   
   547    988       case TCL_LINK_STRING:
   548    989   	value = TclGetString(valueObj);
   549    990   	valueLength = valueObj->length + 1;
   550    991   	pp = (char **) linkPtr->addr;
   551    992   
   552    993   	*pp = ckrealloc(*pp, valueLength);
   553    994   	memcpy(*pp, value, valueLength);
   554    995   	break;
          996  +
          997  +    case TCL_LINK_CHARS:
          998  +	value = (char *) Tcl_GetStringFromObj(valueObj, &valueLength);
          999  +	valueLength++;		/* include end of string char */
         1000  +	if (valueLength > linkPtr->bytes) {
         1001  +	    return (char *) "wrong size of char* value";
         1002  +	}
         1003  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
         1004  +	    memcpy(linkPtr->lastValue.aryPtr, value, (size_t) valueLength);
         1005  +	    memcpy(linkPtr->addr, value, (size_t) valueLength);
         1006  +	} else {
         1007  +	    linkPtr->lastValue.c = '\0';
         1008  +	    LinkedVar(char) = linkPtr->lastValue.c;
         1009  +	}
         1010  +	break;
         1011  +
         1012  +    case TCL_LINK_BINARY:
         1013  +	value = (char *) Tcl_GetByteArrayFromObj(valueObj, &valueLength);
         1014  +	if (valueLength != linkPtr->bytes) {
         1015  +	    return (char *) "wrong size of binary value";
         1016  +	}
         1017  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
         1018  +	    memcpy(linkPtr->lastValue.aryPtr, value, (size_t) valueLength);
         1019  +	    memcpy(linkPtr->addr, value, (size_t) valueLength);
         1020  +	} else {
         1021  +	    linkPtr->lastValue.uc = (unsigned char) *value;
         1022  +	    LinkedVar(unsigned char) = linkPtr->lastValue.uc;
         1023  +	}
         1024  +	break;
   555   1025   
   556   1026       default:
   557   1027   	return (char *) "internal error: bad linked variable type";
   558   1028       }
   559   1029       return NULL;
   560   1030   }
   561   1031   
................................................................................
   579   1049   
   580   1050   static Tcl_Obj *
   581   1051   ObjValue(
   582   1052       Link *linkPtr)		/* Structure describing linked variable. */
   583   1053   {
   584   1054       char *p;
   585   1055       Tcl_Obj *resultObj;
         1056  +    int objc;
         1057  +    static Tcl_Obj **objv = NULL; // WTF?
         1058  +    int i;
   586   1059   
   587   1060       switch (linkPtr->type) {
   588   1061       case TCL_LINK_INT:
         1062  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
         1063  +	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
         1064  +	    objc = linkPtr->bytes / sizeof(int);
         1065  +	    objv = ckrealloc(objv, objc * sizeof(Tcl_Obj *));
         1066  +	    for (i=0; i < objc; i++) {
         1067  +		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.pi[i]);
         1068  +	    }
         1069  +	    return Tcl_NewListObj(objc, objv);
         1070  +	}
   589   1071   	linkPtr->lastValue.i = LinkedVar(int);
   590   1072   	return Tcl_NewIntObj(linkPtr->lastValue.i);
   591   1073       case TCL_LINK_WIDE_INT:
         1074  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
         1075  +	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
         1076  +	    objc = linkPtr->bytes / sizeof(Tcl_WideInt);
         1077  +	    objv = ckrealloc(objv, objc * sizeof(Tcl_Obj *));
         1078  +	    for (i=0; i < objc; i++) {
         1079  +		objv[i] = Tcl_NewWideIntObj(linkPtr->lastValue.pw[i]);
         1080  +	    }
         1081  +	    return Tcl_NewListObj(objc, objv);
         1082  +	}
   592   1083   	linkPtr->lastValue.w = LinkedVar(Tcl_WideInt);
   593   1084   	return Tcl_NewWideIntObj(linkPtr->lastValue.w);
   594   1085       case TCL_LINK_DOUBLE:
         1086  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
         1087  +	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
         1088  +	    objc = linkPtr->bytes / sizeof(double);
         1089  +	    objv = ckrealloc(objv, objc * sizeof(Tcl_Obj *));
         1090  +	    for (i=0; i < objc; i++) {
         1091  +		objv[i] = Tcl_NewDoubleObj(linkPtr->lastValue.pd[i]);
         1092  +	    }
         1093  +	    return Tcl_NewListObj(objc, objv);
         1094  +	}
   595   1095   	linkPtr->lastValue.d = LinkedVar(double);
   596   1096   	return Tcl_NewDoubleObj(linkPtr->lastValue.d);
   597   1097       case TCL_LINK_BOOLEAN:
         1098  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
         1099  +	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
         1100  +	    objc = linkPtr->bytes/sizeof(int);
         1101  +	    objv = ckrealloc(objv, objc * sizeof(Tcl_Obj *));
         1102  +	    for (i=0; i < objc; i++) {
         1103  +		objv[i] = Tcl_NewBooleanObj(linkPtr->lastValue.pi[i] != 0);
         1104  +	    }
         1105  +	    return Tcl_NewListObj(objc, objv);
         1106  +	}
   598   1107   	linkPtr->lastValue.i = LinkedVar(int);
   599   1108   	return Tcl_NewBooleanObj(linkPtr->lastValue.i);
   600   1109       case TCL_LINK_CHAR:
         1110  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
         1111  +	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
         1112  +	    objc = linkPtr->bytes / sizeof(char);
         1113  +	    objv = ckrealloc(objv, objc * sizeof(Tcl_Obj *));
         1114  +	    for (i=0; i < objc; i++) {
         1115  +		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.pc[i]);
         1116  +	    }
         1117  +	    return Tcl_NewListObj(objc, objv);
         1118  +	}
   601   1119   	linkPtr->lastValue.c = LinkedVar(char);
   602   1120   	return Tcl_NewIntObj(linkPtr->lastValue.c);
   603   1121       case TCL_LINK_UCHAR:
         1122  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
         1123  +	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
         1124  +	    objc = linkPtr->bytes / sizeof(unsigned char);
         1125  +	    objv = ckrealloc(objv, objc * sizeof(Tcl_Obj *));
         1126  +	    for (i=0; i < objc; i++) {
         1127  +		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.puc[i]);
         1128  +	    }
         1129  +	    return Tcl_NewListObj(objc, objv);
         1130  +	}
   604   1131   	linkPtr->lastValue.uc = LinkedVar(unsigned char);
   605   1132   	return Tcl_NewIntObj(linkPtr->lastValue.uc);
   606   1133       case TCL_LINK_SHORT:
         1134  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
         1135  +	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
         1136  +	    objc = linkPtr->bytes / sizeof(short);
         1137  +	    objv = ckrealloc(objv, objc * sizeof(Tcl_Obj*));
         1138  +	    for (i=0; i < objc; i++) {
         1139  +		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.ps[i]);
         1140  +	    }
         1141  +	    return Tcl_NewListObj(objc, objv);
         1142  +	}
   607   1143   	linkPtr->lastValue.s = LinkedVar(short);
   608   1144   	return Tcl_NewIntObj(linkPtr->lastValue.s);
   609   1145       case TCL_LINK_USHORT:
         1146  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
         1147  +	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
         1148  +	    objc = linkPtr->bytes / sizeof(unsigned short);
         1149  +	    objv = ckrealloc(objv, objc * sizeof(Tcl_Obj*));
         1150  +	    for (i=0; i < objc; i++) {
         1151  +		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.pus[i]);
         1152  +	    }
         1153  +	    return Tcl_NewListObj(objc, objv);
         1154  +	}
   610   1155   	linkPtr->lastValue.us = LinkedVar(unsigned short);
   611   1156   	return Tcl_NewIntObj(linkPtr->lastValue.us);
   612   1157       case TCL_LINK_UINT:
         1158  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
         1159  +	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
         1160  +	    objc = linkPtr->bytes / sizeof(unsigned int);
         1161  +	    objv = ckrealloc(objv, objc * sizeof(Tcl_Obj *));
         1162  +	    for (i=0; i < objc; i++) {
         1163  +		objv[i] = Tcl_NewWideIntObj(linkPtr->lastValue.pui[i]);
         1164  +	    }
         1165  +	    return Tcl_NewListObj(objc, objv);
         1166  +	}
   613   1167   	linkPtr->lastValue.ui = LinkedVar(unsigned int);
   614   1168   	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ui);
   615   1169   #if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
   616   1170       case TCL_LINK_LONG:
         1171  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
         1172  +	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
         1173  +	    objc = linkPtr->bytes / sizeof(long);
         1174  +	    objv = ckrealloc(objv, objc * sizeof(Tcl_Obj *));
         1175  +	    for (i=0; i < objc; i++) {
         1176  +		objv[i] = Tcl_NewWideIntObj(linkPtr->lastValue.pl[i]);
         1177  +	    }
         1178  +	    return Tcl_NewListObj(objc, objv);
         1179  +	}
   617   1180   	linkPtr->lastValue.l = LinkedVar(long);
   618   1181   	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.l);
   619   1182       case TCL_LINK_ULONG:
         1183  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
         1184  +	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
         1185  +	    objc = linkPtr->bytes / sizeof(unsigned long);
         1186  +	    objv = ckrealloc(objv, objc * sizeof(Tcl_Obj *));
         1187  +	    for (i=0; i < objc; i++) {
         1188  +		objv[i] = Tcl_NewWideIntObj(linkPtr->lastValue.pul[i]);
         1189  +	    }
         1190  +	    return Tcl_NewListObj(objc, objv);
         1191  +	}
   620   1192   	linkPtr->lastValue.ul = LinkedVar(unsigned long);
   621   1193   	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ul);
   622   1194   #endif
   623   1195       case TCL_LINK_FLOAT:
         1196  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
         1197  +	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
         1198  +	    objc = linkPtr->bytes / sizeof(float);
         1199  +	    objv = ckrealloc(objv, objc * sizeof(Tcl_Obj *));
         1200  +	    for (i=0; i < objc; i++) {
         1201  +		objv[i] = Tcl_NewDoubleObj(linkPtr->lastValue.pf[i]);
         1202  +	    }
         1203  +	    return Tcl_NewListObj(objc, objv);
         1204  +	}
   624   1205   	linkPtr->lastValue.f = LinkedVar(float);
   625   1206   	return Tcl_NewDoubleObj(linkPtr->lastValue.f);
   626   1207       case TCL_LINK_WIDE_UINT:
   627         -	linkPtr->lastValue.uw = LinkedVar(Tcl_WideUInt);
   628   1208   	/*
   629   1209   	 * FIXME: represent as a bignum.
   630   1210   	 */
         1211  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
         1212  +	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
         1213  +	    objc = linkPtr->bytes / sizeof(Tcl_WideUInt);
         1214  +	    objv = ckrealloc(objv, objc * sizeof(Tcl_Obj *));
         1215  +	    for (i=0; i < objc; i++) {
         1216  +		objv[i] = Tcl_NewWideIntObj((Tcl_WideInt)
         1217  +			linkPtr->lastValue.puw[i]);
         1218  +	    }
         1219  +	    return Tcl_NewListObj(objc, objv);
         1220  +	}
         1221  +	linkPtr->lastValue.uw = LinkedVar(Tcl_WideUInt);
   631   1222   	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.uw);
   632   1223       case TCL_LINK_STRING:
   633   1224   	p = LinkedVar(char *);
   634   1225   	if (p == NULL) {
   635   1226   	    TclNewLiteralStringObj(resultObj, "NULL");
   636   1227   	    return resultObj;
   637   1228   	}
   638   1229   	return Tcl_NewStringObj(p, -1);
   639   1230   
         1231  +    case TCL_LINK_CHARS:
         1232  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
         1233  +	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
         1234  +	    linkPtr->lastValue.pc[linkPtr->bytes-1] = '\0';
         1235  +	    /* take care of proper string end */
         1236  +	    return Tcl_NewStringObj(linkPtr->lastValue.pc, linkPtr->bytes);
         1237  +	}
         1238  +	linkPtr->lastValue.c = '\0';
         1239  +	return Tcl_NewStringObj(&linkPtr->lastValue.c, 1);
         1240  +
         1241  +    case TCL_LINK_BINARY:
         1242  +	if (linkPtr->flags & LINK_ALLOC_LAST) {
         1243  +	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
         1244  +	    return Tcl_NewByteArrayObj((unsigned char *) linkPtr->addr,
         1245  +		    linkPtr->bytes);
         1246  +	}
         1247  +	linkPtr->lastValue.uc = LinkedVar(unsigned char);
         1248  +	return Tcl_NewByteArrayObj(&linkPtr->lastValue.uc, 1);
         1249  +
   640   1250       /*
   641   1251        * This code only gets executed if the link type is unknown (shouldn't
   642   1252        * ever happen).
   643   1253        */
   644   1254   
   645   1255       default:
   646   1256   	TclNewLiteralStringObj(resultObj, "??");
................................................................................
   692   1302   
   693   1303   /*
   694   1304    * This function checks for integer representations, which are valid
   695   1305    * when linking with C variables, but which are invalid in other
   696   1306    * contexts in Tcl. Handled are "+", "-", "", "0x", "0b", "0d" and "0o"
   697   1307    * (upperand lowercase). See bug [39f6304c2e].
   698   1308    */
         1309  +
   699   1310   int
   700   1311   GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr)
   701   1312   {
   702   1313       const char *str = TclGetString(objPtr);
   703   1314   
   704   1315       if ((objPtr->length == 0) ||
   705   1316   	    ((objPtr->length == 2) && (str[0] == '0') && strchr("xXbBoOdD", str[1]))) {
................................................................................
   726   1337   
   727   1338   /*
   728   1339    * This function checks for double representations, which are valid
   729   1340    * when linking with C variables, but which are invalid in other
   730   1341    * contexts in Tcl. Handled are "+", "-", "", ".", "0x", "0b" and "0o"
   731   1342    * (upper- and lowercase) and sequences like "1e-". See bug [39f6304c2e].
   732   1343    */
         1344  +
   733   1345   int
   734   1346   GetInvalidDoubleFromObj(Tcl_Obj *objPtr, double *doublePtr)
   735   1347   {
   736   1348       int intValue;
   737   1349   
   738   1350       if (TclHasIntRep(objPtr, &invalidRealType)) {
   739   1351   	goto gotdouble;
................................................................................
   745   1357       if (SetInvalidRealFromAny(NULL, objPtr) == TCL_OK) {
   746   1358       gotdouble:
   747   1359   	*doublePtr = objPtr->internalRep.doubleValue;
   748   1360   	return TCL_OK;
   749   1361       }
   750   1362       return TCL_ERROR;
   751   1363   }
         1364  +
         1365  +/*
         1366  + *----------------------------------------------------------------------
         1367  + *
         1368  + * LinkFree --
         1369  + *
         1370  + *	Free's allocated space of given link and link structure.
         1371  + *
         1372  + * Results:
         1373  + *	None.
         1374  + *
         1375  + * Side effects:
         1376  + *	None.
         1377  + *
         1378  + *----------------------------------------------------------------------
         1379  + */
         1380  +
         1381  +static void
         1382  +LinkFree(
         1383  +    Link *linkPtr)		/* Structure describing linked variable. */
         1384  +{
         1385  +    if (linkPtr->flags & LINK_ALLOC_ADDR) {
         1386  +	ckfree(linkPtr->addr);
         1387  +    }
         1388  +    if (linkPtr->flags & LINK_ALLOC_LAST) {
         1389  +	ckfree(linkPtr->lastValue.aryPtr);
         1390  +    }
         1391  +    ckfree((char *) linkPtr);
         1392  +}
   752   1393   
   753   1394   /*
   754   1395    * Local Variables:
   755   1396    * mode: c
   756   1397    * c-basic-offset: 4
   757   1398    * fill-column: 78
   758   1399    * End:
   759   1400    */

Changes to generic/tclStubInit.c.

  1624   1624       Tcl_InitStringRep, /* 637 */
  1625   1625       Tcl_FetchIntRep, /* 638 */
  1626   1626       Tcl_StoreIntRep, /* 639 */
  1627   1627       Tcl_HasStringRep, /* 640 */
  1628   1628       Tcl_IncrRefCount, /* 641 */
  1629   1629       Tcl_DecrRefCount, /* 642 */
  1630   1630       Tcl_IsShared, /* 643 */
         1631  +    Tcl_LinkArray, /* 644 */
  1631   1632   };
  1632   1633   
  1633   1634   /* !END!: Do not edit above this line. */

Changes to generic/tclTest.c.

   304    304   static int		TestgetvarfullnameCmd(
   305    305   			    void *dummy, Tcl_Interp *interp,
   306    306   			    int objc, Tcl_Obj *const objv[]);
   307    307   static int		TestinterpdeleteCmd(void *dummy,
   308    308   			    Tcl_Interp *interp, int argc, const char **argv);
   309    309   static int		TestlinkCmd(void *dummy,
   310    310   			    Tcl_Interp *interp, int argc, const char **argv);
          311  +static int		TestlinkarrayCmd(void *dummy, Tcl_Interp *interp,
          312  +			    int objc, Tcl_Obj *const *objv);
   311    313   static int		TestlocaleCmd(void *dummy,
   312    314   			    Tcl_Interp *interp, int objc,
   313    315   			    Tcl_Obj *const objv[]);
   314    316   static int		TestmainthreadCmd(void *dummy,
   315    317   			    Tcl_Interp *interp, int argc, const char **argv);
   316    318   static int		TestsetmainloopCmd(void *dummy,
   317    319   			    Tcl_Interp *interp, int argc, const char **argv);
................................................................................
   661    663       Tcl_CreateCommand(interp, "testgetplatform", TestgetplatformCmd,
   662    664   	    NULL, NULL);
   663    665       Tcl_CreateObjCommand(interp, "testgetvarfullname",
   664    666   	    TestgetvarfullnameCmd, NULL, NULL);
   665    667       Tcl_CreateCommand(interp, "testinterpdelete", TestinterpdeleteCmd,
   666    668   	    NULL, NULL);
   667    669       Tcl_CreateCommand(interp, "testlink", TestlinkCmd, NULL, NULL);
          670  +    Tcl_CreateObjCommand(interp, "testlinkarray", TestlinkarrayCmd, NULL, NULL);
   668    671       Tcl_CreateObjCommand(interp, "testlocale", TestlocaleCmd, NULL,
   669    672   	    NULL);
   670    673       Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, NULL, NULL);
   671    674       Tcl_CreateObjCommand(interp, "testparseargs", TestparseargsCmd,NULL,NULL);
   672    675       Tcl_CreateObjCommand(interp, "testparser", TestparserObjCmd,
   673    676   	    NULL, NULL);
   674    677       Tcl_CreateObjCommand(interp, "testparsevar", TestparsevarObjCmd,
................................................................................
  3275   3278       } else {
  3276   3279   	Tcl_AppendResult(interp, "bad option \"", argv[1],
  3277   3280   		"\": should be create, delete, get, set, or update", NULL);
  3278   3281   	return TCL_ERROR;
  3279   3282       }
  3280   3283       return TCL_OK;
  3281   3284   }
         3285  +
         3286  +/*
         3287  + *----------------------------------------------------------------------
         3288  + *
         3289  + * TestlinkarrayCmd --
         3290  + *
         3291  + *      This function is invoked to process the "testlinkarray" Tcl command.
         3292  + *      It is used to test the 'Tcl_LinkArray' function.
         3293  + *
         3294  + * Results:
         3295  + *      A standard Tcl result.
         3296  + *
         3297  + * Side effects:
         3298  + *	Creates, deletes, and invokes variable links.
         3299  + *
         3300  + *----------------------------------------------------------------------
         3301  + */
         3302  +
         3303  +static int
         3304  +TestlinkarrayCmd(
         3305  +    ClientData dummy,           /* Not used. */
         3306  +    Tcl_Interp *interp,         /* Current interpreter. */
         3307  +    int objc,                   /* Number of arguments. */
         3308  +    Tcl_Obj *const objv[])      /* Argument objects. */
         3309  +{
         3310  +    static const char *LinkOption[] = {
         3311  +        "update", "remove", "create", NULL
         3312  +    };
         3313  +    enum LinkOption { LINK_UPDATE, LINK_REMOVE, LINK_CREATE };
         3314  +    static const char *LinkType[] = {
         3315  +	"char", "uchar", "short", "ushort", "int", "uint", "long", "ulong",
         3316  +	"wide", "uwide", "float", "double", "string", "char*", "binary", NULL
         3317  +    };
         3318  +    /* all values after TCL_LINK_CHARS_ARRAY are used as arrays (see below) */
         3319  +    static int LinkTypes[] = {
         3320  +	TCL_LINK_CHAR, TCL_LINK_UCHAR,
         3321  +	TCL_LINK_SHORT, TCL_LINK_USHORT, TCL_LINK_INT, TCL_LINK_UINT,
         3322  +	TCL_LINK_LONG, TCL_LINK_ULONG, TCL_LINK_WIDE_INT, TCL_LINK_WIDE_UINT,
         3323  +	TCL_LINK_FLOAT, TCL_LINK_DOUBLE, TCL_LINK_STRING, TCL_LINK_CHARS,
         3324  +	TCL_LINK_BINARY
         3325  +    };
         3326  +    int optionIndex, typeIndex, readonly, i, addr, size, length;
         3327  +    char *name, *arg;
         3328  +
         3329  +    if (objc < 2) {
         3330  +	Tcl_WrongNumArgs(interp, 1, objv, "option args");
         3331  +	return TCL_ERROR;
         3332  +    }
         3333  +    if (Tcl_GetIndexFromObj(interp, objv[1], LinkOption, "option", 0,
         3334  +	    &optionIndex) != TCL_OK) {
         3335  +	return TCL_ERROR;
         3336  +    }
         3337  +    switch ((enum LinkOption) optionIndex) {
         3338  +    case LINK_UPDATE:
         3339  +	for (i=2; i<objc; i++) {
         3340  +	    Tcl_UpdateLinkedVar(interp, Tcl_GetString(objv[i]));
         3341  +	}
         3342  +	return TCL_OK;
         3343  +    case LINK_REMOVE:
         3344  +	for (i=2; i<objc; i++) {
         3345  +	    Tcl_UnlinkVar(interp, Tcl_GetString(objv[i]));
         3346  +	}
         3347  +	return TCL_OK;
         3348  +    case LINK_CREATE:
         3349  +	if (objc < 4) {
         3350  +	    goto wrongArgs;
         3351  +	}
         3352  +	readonly = 0;
         3353  +	i = 2;
         3354  +
         3355  +	/*
         3356  +	 * test on switch -r...
         3357  +	 */
         3358  +
         3359  +	arg = Tcl_GetStringFromObj(objv[i], &length);
         3360  +	if (length < 2) {
         3361  +	    goto wrongArgs;
         3362  +	}
         3363  +	if (arg[0] == '-') {
         3364  +	    if (arg[1] != 'r') {
         3365  +		goto wrongArgs;
         3366  +	    }
         3367  +	    readonly = TCL_LINK_READ_ONLY;
         3368  +	    i++;
         3369  +	}
         3370  +	if (Tcl_GetIndexFromObj(interp, objv[i++], LinkType, "type", 0,
         3371  + 		&typeIndex) != TCL_OK) {
         3372  +	    return TCL_ERROR;
         3373  +	}
         3374  +	if (Tcl_GetIntFromObj(interp, objv[i++], &size) == TCL_ERROR) {
         3375  +	    Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong size value", -1));
         3376  +	    return TCL_ERROR;
         3377  +	}
         3378  +	name = Tcl_GetString(objv[i++]);
         3379  +
         3380  +	/*
         3381  +	 * If no address is given request one in the underlying function
         3382  +	 */
         3383  +
         3384  +	if (i < objc) {
         3385  +	    if (Tcl_GetIntFromObj(interp, objv[i], &addr) == TCL_ERROR) {
         3386  + 		Tcl_SetObjResult(interp, Tcl_NewStringObj(
         3387  +			"wrong address value", -1));
         3388  +		return TCL_ERROR;
         3389  +	    }
         3390  +	} else {
         3391  +	    addr = 0;
         3392  +	}
         3393  +	return Tcl_LinkArray(interp, name, (char *) addr,
         3394  +		LinkTypes[typeIndex] | readonly, size);
         3395  +    }
         3396  +    return TCL_OK;
         3397  +
         3398  +  wrongArgs:
         3399  +    Tcl_WrongNumArgs(interp, 2, objv, "?-readonly? type size name ?address?");
         3400  +    return TCL_ERROR;
         3401  +}
  3282   3402   
  3283   3403   /*
  3284   3404    *----------------------------------------------------------------------
  3285   3405    *
  3286   3406    * TestlocaleCmd --
  3287   3407    *
  3288   3408    *	This procedure implements the "testlocale" command.  It is used

Changes to tests/link.test.

    16     16       namespace import -force ::tcltest::*
    17     17   }
    18     18   
    19     19   ::tcltest::loadTestedCommands
    20     20   catch [list package require -exact Tcltest [info patchlevel]]
    21     21   
    22     22   testConstraint testlink [llength [info commands testlink]]
           23  +testConstraint testlinkarray [llength [info commands testlinkarray]]
    23     24   
    24     25   foreach i {int real bool string} {
    25     26       unset -nocomplain $i
    26     27   }
    27     28   
    28     29   test link-1.1 {reading C variables from Tcl} -constraints {testlink} -setup {
    29     30       testlink delete
................................................................................
    84     85   } -result {1 {can't set "bool": variable must have boolean value} 1}
    85     86   test link-2.5 {writing bad values into variables} -setup {
    86     87       testlink delete
    87     88   } -constraints {testlink} -body {
    88     89       testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    89     90       testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    90     91       list [catch {set wide gorp} msg] $msg $bool
    91         -} -result {1 {can't set "wide": variable must have integer value} 1}
           92  +} -result {1 {can't set "wide": variable must have wide integer value} 1}
    92     93   test link-2.6 {writing C variables from Tcl} -constraints {testlink} -setup {
    93     94       testlink delete
    94     95   } -body {
    95     96       testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234
    96     97       testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    97     98       set int "+"
    98     99       set real "+"
................................................................................
   359    360       proc x {} {
   360    361   	upvar wide y
   361    362   	set y abc
   362    363       }
   363    364       testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
   364    365       testlink set -4 16.3 1 {} 778899 {} {} {} {} {} {} {} {} {}
   365    366       list [catch x msg] $msg $wide
   366         -} -result {1 {can't set "y": variable must have integer value} 778899}
          367  +} -result {1 {can't set "y": variable must have wide integer value} 778899}
   367    368   
   368    369   test link-8.1 {Tcl_UpdateLinkedVar procedure} {testlink} {
   369    370       proc x args {
   370    371   	global x int real bool string wide
   371    372   	lappend x $args $int $real $bool $string $wide
   372    373       }
   373    374       set x {}
................................................................................
   394    395   } {}
   395    396   test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} {testlink} {
   396    397       testlink create 0 0 0 0 0 0 0 0 0 0 0 0 0 0
   397    398       list [catch {
   398    399   	testlink update 47 {} {} {} {} {} {} {} {} {} {} {} {} {}
   399    400       } msg] $msg $int
   400    401   } {0 {} 47}
          402  +
          403  +test link-9.1 {linkarray usage messages} {
          404  +    set mylist [list]
          405  +    catch {testlinkarray} my(msg)
          406  +    lappend mylist $my(msg)
          407  +    unset my(msg)
          408  +    catch {testlinkarray x} my(msg)
          409  +    lappend mylist $my(msg)
          410  +    unset my(msg)
          411  +    catch {testlinkarray update} my(msg)
          412  +    lappend mylist $my(msg)
          413  +    unset my(msg)
          414  +    catch {testlinkarray remove} my(msg)
          415  +    lappend mylist $my(msg)
          416  +    unset my(msg)
          417  +    catch {testlinkarray create} my(msg)
          418  +    lappend mylist $my(msg)
          419  +    unset my(msg)
          420  +    catch {testlinkarray create xx 1 my} my(msg)
          421  +    lappend mylist $my(msg)
          422  +    unset my(msg)
          423  +    catch {testlinkarray create char* 0 my} my(msg)
          424  +    lappend mylist $my(msg)
          425  +    unset my(msg)
          426  +    join $mylist "\n"
          427  +} {wrong # args: should be "testlinkarray option args"
          428  +bad option "x": must be update, remove, or create
          429  +
          430  +
          431  +wrong # args: should be "testlinkarray create ?-readonly? type size name ?address?"
          432  +bad type "xx": must be char, uchar, short, ushort, int, uint, long, ulong, wide, uwide, float, double, string, char*, or binary
          433  +wrong array size given}
          434  +
          435  +test link-10.1 {linkarray char*} {
          436  +    set mylist [list]
          437  +    testlinkarray create char* 1 ::my(var)
          438  +    lappend mylist [set ::my(var) ""]
          439  +    catch {set ::my(var) x} my(msg)
          440  +    lappend mylist $my(msg)
          441  +    unset my(msg)
          442  +    testlinkarray remove ::my(var)
          443  +    testlinkarray create char* 4 ::my(var)
          444  +    set ::my(var) x
          445  +    catch {set ::my(var) xyzz} my(msg)
          446  +    lappend mylist $my(msg)
          447  +    unset my(msg)
          448  +    testlinkarray remove ::my(var)
          449  +    testlinkarray create -r char* 4 ::my(var)
          450  +    catch {set ::my(var) x} my(msg)
          451  +    lappend mylist $my(msg)
          452  +    unset my(msg)
          453  +    testlinkarray remove ::my(var)
          454  +    unset my
          455  +    join $mylist "\n"
          456  +} {
          457  +can't set "::my(var)": wrong size of char* value
          458  +can't set "::my(var)": wrong size of char* value
          459  +can't set "::my(var)": linked variable is read-only}
          460  +
          461  +test link-11.1 {linkarray char} {
          462  +    set mylist [list]
          463  +    testlinkarray create char 1 ::my(var)
          464  +    catch {set ::my(var) x} my(msg)
          465  +    lappend mylist $my(msg)
          466  +    unset my(msg)
          467  +    lappend mylist [set ::my(var) 120]
          468  +    catch {set ::my(var) 1234} my(msg)
          469  +    lappend mylist $my(msg)
          470  +    unset my(msg)
          471  +    testlinkarray remove ::my(var)
          472  +    testlinkarray create char 4 ::my(var)
          473  +    catch {set ::my(var) {1 2 3}} my(msg)
          474  +    lappend mylist $my(msg)
          475  +    unset my(msg)
          476  +    set ::my(var) {1 2 3 4}
          477  +    lappend mylist $my(var)
          478  +    testlinkarray remove ::my(var)
          479  +    testlinkarray create -r char 2 ::my(var)
          480  +    catch {set ::my(var) {1 2}} my(msg)
          481  +    lappend mylist $my(msg)
          482  +    unset my(msg)
          483  +    testlinkarray remove ::my(var)
          484  +    unset my
          485  +    join $mylist "\n"
          486  +} {can't set "::my(var)": variable must have char value
          487  +120
          488  +can't set "::my(var)": variable must have char value
          489  +can't set "::my(var)": wrong dimension
          490  +1 2 3 4
          491  +can't set "::my(var)": linked variable is read-only}
          492  +
          493  +test link-12.1 {linkarray unsigned char} {
          494  +    set mylist [list]
          495  +    testlinkarray create uchar 1 ::my(var)
          496  +    catch {set ::my(var) x} my(msg)
          497  +    lappend mylist $my(msg)
          498  +    unset my(msg)
          499  +    lappend mylist [set ::my(var) 120]
          500  +    catch {set ::my(var) 1234} my(msg)
          501  +    lappend mylist $my(msg)
          502  +    unset my(msg)
          503  +    catch {set ::my(var) -1} my(msg)
          504  +    lappend mylist $my(msg)
          505  +    unset my(msg)
          506  +    testlinkarray remove ::my(var)
          507  +    testlinkarray create uchar 4 ::my(var)
          508  +    catch {set ::my(var) {1 2 3}} my(msg)
          509  +    lappend mylist $my(msg)
          510  +    unset my(msg)
          511  +    set ::my(var) {1 2 3 4}
          512  +    lappend mylist $my(var)
          513  +    testlinkarray remove ::my(var)
          514  +    testlinkarray create -r uchar 2 ::my(var)
          515  +    catch {set ::my(var) {1 2}} my(msg)
          516  +    lappend mylist $my(msg)
          517  +    unset my(msg)
          518  +    testlinkarray remove ::my(var)
          519  +    unset my
          520  +    join $mylist "\n"
          521  +} {can't set "::my(var)": variable must have unsigned char value
          522  +120
          523  +can't set "::my(var)": variable must have unsigned char value
          524  +can't set "::my(var)": variable must have unsigned char value
          525  +can't set "::my(var)": wrong dimension
          526  +1 2 3 4
          527  +can't set "::my(var)": linked variable is read-only}
          528  +
          529  +test link-13.1 {linkarray short} {
          530  +    set mylist [list]
          531  +    testlinkarray create short 1 ::my(var)
          532  +    catch {set ::my(var) x} my(msg)
          533  +    lappend mylist $my(msg)
          534  +    unset my(msg)
          535  +    lappend mylist [set ::my(var) 120]
          536  +    catch {set ::my(var) 123456} my(msg)
          537  +    lappend mylist $my(msg)
          538  +    unset my(msg)
          539  +    testlinkarray remove ::my(var)
          540  +    testlinkarray create short 4 ::my(var)
          541  +    catch {set ::my(var) {1 2 3}} my(msg)
          542  +    lappend mylist $my(msg)
          543  +    unset my(msg)
          544  +    set ::my(var) {1 2 3 4}
          545  +    lappend mylist $my(var)
          546  +    testlinkarray remove ::my(var)
          547  +    testlinkarray create -r short 2 ::my(var)
          548  +    catch {set ::my(var) {1 2}} my(msg)
          549  +    lappend mylist $my(msg)
          550  +    unset my(msg)
          551  +    testlinkarray remove ::my(var)
          552  +    unset my
          553  +    join $mylist "\n"
          554  +} {can't set "::my(var)": variable must have short value
          555  +120
          556  +can't set "::my(var)": variable must have short value
          557  +can't set "::my(var)": wrong dimension
          558  +1 2 3 4
          559  +can't set "::my(var)": linked variable is read-only}
          560  +
          561  +test link-14.1 {linkarray unsigned short} {
          562  +    set mylist [list]
          563  +    testlinkarray create ushort 1 ::my(var)
          564  +    catch {set ::my(var) x} my(msg)
          565  +    lappend mylist $my(msg)
          566  +    unset my(msg)
          567  +    lappend mylist [set ::my(var) 120]
          568  +    catch {set ::my(var) 123456} my(msg)
          569  +    lappend mylist $my(msg)
          570  +    unset my(msg)
          571  +    catch {set ::my(var) -1} my(msg)
          572  +    lappend mylist $my(msg)
          573  +    unset my(msg)
          574  +    testlinkarray remove ::my(var)
          575  +    testlinkarray create ushort 4 ::my(var)
          576  +    catch {set ::my(var) {1 2 3}} my(msg)
          577  +    lappend mylist $my(msg)
          578  +    unset my(msg)
          579  +    set ::my(var) {1 2 3 4}
          580  +    lappend mylist $my(var)
          581  +    testlinkarray remove ::my(var)
          582  +    testlinkarray create -r ushort 2 ::my(var)
          583  +    catch {set ::my(var) {1 2}} my(msg)
          584  +    lappend mylist $my(msg)
          585  +    unset my(msg)
          586  +    testlinkarray remove ::my(var)
          587  +    unset my
          588  +    join $mylist "\n"
          589  +} {can't set "::my(var)": variable must have unsigned short value
          590  +120
          591  +can't set "::my(var)": variable must have unsigned short value
          592  +can't set "::my(var)": variable must have unsigned short value
          593  +can't set "::my(var)": wrong dimension
          594  +1 2 3 4
          595  +can't set "::my(var)": linked variable is read-only}
          596  +
          597  +test link-15.1 {linkarray int} {
          598  +    set mylist [list]
          599  +    testlinkarray create int 1 ::my(var)
          600  +    catch {set ::my(var) x} my(msg)
          601  +    lappend mylist $my(msg)
          602  +    unset my(msg)
          603  +    lappend mylist [set ::my(var) 120]
          604  +    catch {set ::my(var) 1e3} my(msg)
          605  +    lappend mylist $my(msg)
          606  +    unset my(msg)
          607  +    testlinkarray remove ::my(var)
          608  +    testlinkarray create int 4 ::my(var)
          609  +    catch {set ::my(var) {1 2 3}} my(msg)
          610  +    lappend mylist $my(msg)
          611  +    unset my(msg)
          612  +    set ::my(var) {1 2 3 4}
          613  +    lappend mylist $my(var)
          614  +    testlinkarray remove ::my(var)
          615  +    testlinkarray create -r int 2 ::my(var)
          616  +    catch {set ::my(var) {1 2}} my(msg)
          617  +    lappend mylist $my(msg)
          618  +    unset my(msg)
          619  +    testlinkarray remove ::my(var)
          620  +    unset my
          621  +    join $mylist "\n"
          622  +} {can't set "::my(var)": variable must have integer value
          623  +120
          624  +can't set "::my(var)": variable must have integer value
          625  +can't set "::my(var)": wrong dimension
          626  +1 2 3 4
          627  +can't set "::my(var)": linked variable is read-only}
          628  +
          629  +test link-16.1 {linkarray unsigned int} {
          630  +    set mylist [list]
          631  +    testlinkarray create uint 1 ::my(var)
          632  +    catch {set ::my(var) x} my(msg)
          633  +    lappend mylist $my(msg)
          634  +    unset my(msg)
          635  +    lappend mylist [set ::my(var) 120]
          636  +    catch {set ::my(var) 1e33} my(msg)
          637  +    lappend mylist $my(msg)
          638  +    unset my(msg)
          639  +    catch {set ::my(var) -1} my(msg)
          640  +    lappend mylist $my(msg)
          641  +    unset my(msg)
          642  +    testlinkarray remove ::my(var)
          643  +    testlinkarray create uint 4 ::my(var)
          644  +    catch {set ::my(var) {1 2 3}} my(msg)
          645  +    lappend mylist $my(msg)
          646  +    unset my(msg)
          647  +    set ::my(var) {1 2 3 4}
          648  +    lappend mylist $my(var)
          649  +    testlinkarray remove ::my(var)
          650  +    testlinkarray create -r uint 2 ::my(var)
          651  +    catch {set ::my(var) {1 2}} my(msg)
          652  +    lappend mylist $my(msg)
          653  +    unset my(msg)
          654  +    testlinkarray remove ::my(var)
          655  +    unset my
          656  +    join $mylist "\n"
          657  +} {can't set "::my(var)": variable must have unsigned int value
          658  +120
          659  +can't set "::my(var)": variable must have unsigned int value
          660  +can't set "::my(var)": variable must have unsigned int value
          661  +can't set "::my(var)": wrong dimension
          662  +1 2 3 4
          663  +can't set "::my(var)": linked variable is read-only}
          664  +
          665  +test link-17.1 {linkarray long} {
          666  +    set mylist [list]
          667  +    testlinkarray create long 1 ::my(var)
          668  +    catch {set ::my(var) x} my(msg)
          669  +    lappend mylist $my(msg)
          670  +    unset my(msg)
          671  +    lappend mylist [set ::my(var) 120]
          672  +    catch {set ::my(var) 1e33} my(msg)
          673  +    lappend mylist $my(msg)
          674  +    unset my(msg)
          675  +    testlinkarray remove ::my(var)
          676  +    testlinkarray create long 4 ::my(var)
          677  +    catch {set ::my(var) {1 2 3}} my(msg)
          678  +    lappend mylist $my(msg)
          679  +    unset my(msg)
          680  +    set ::my(var) {1 2 3 4}
          681  +    lappend mylist $my(var)
          682  +    testlinkarray remove ::my(var)
          683  +    testlinkarray create -r long 2 ::my(var)
          684  +    catch {set ::my(var) {1 2}} my(msg)
          685  +    lappend mylist $my(msg)
          686  +    unset my(msg)
          687  +    testlinkarray remove ::my(var)
          688  +    unset my
          689  +    join $mylist "\n"
          690  +} {can't set "::my(var)": variable must have long value
          691  +120
          692  +can't set "::my(var)": variable must have long value
          693  +can't set "::my(var)": wrong dimension
          694  +1 2 3 4
          695  +can't set "::my(var)": linked variable is read-only}
          696  +
          697  +test link-18.1 {linkarray unsigned long} {
          698  +    set mylist [list]
          699  +    testlinkarray create ulong 1 ::my(var)
          700  +    catch {set ::my(var) x} my(msg)
          701  +    lappend mylist $my(msg)
          702  +    unset my(msg)
          703  +    lappend mylist [set ::my(var) 120]
          704  +    catch {set ::my(var) 1e33} my(msg)
          705  +    lappend mylist $my(msg)
          706  +    unset my(msg)
          707  +    catch {set ::my(var) -1} my(msg)
          708  +    lappend mylist $my(msg)
          709  +    unset my(msg)
          710  +    testlinkarray remove ::my(var)
          711  +    testlinkarray create ulong 4 ::my(var)
          712  +    catch {set ::my(var) {1 2 3}} my(msg)
          713  +    lappend mylist $my(msg)
          714  +    unset my(msg)
          715  +    set ::my(var) {1 2 3 4}
          716  +    lappend mylist $my(var)
          717  +    testlinkarray remove ::my(var)
          718  +    testlinkarray create -r ulong 2 ::my(var)
          719  +    catch {set ::my(var) {1 2}} my(msg)
          720  +    lappend mylist $my(msg)
          721  +    unset my(msg)
          722  +    testlinkarray remove ::my(var)
          723  +    unset my
          724  +    join $mylist "\n"
          725  +} {can't set "::my(var)": variable must have unsigned long value
          726  +120
          727  +can't set "::my(var)": variable must have unsigned long value
          728  +can't set "::my(var)": variable must have unsigned long value
          729  +can't set "::my(var)": wrong dimension
          730  +1 2 3 4
          731  +can't set "::my(var)": linked variable is read-only}
          732  +
          733  +test link-19.1 {linkarray wide} {
          734  +    set mylist [list]
          735  +    testlinkarray create wide 1 ::my(var)
          736  +    catch {set ::my(var) x} my(msg)
          737  +    lappend mylist $my(msg)
          738  +    unset my(msg)
          739  +    lappend mylist [set ::my(var) 120]
          740  +    catch {set ::my(var) 1e33} my(msg)
          741  +    lappend mylist $my(msg)
          742  +    unset my(msg)
          743  +    testlinkarray remove ::my(var)
          744  +    testlinkarray create wide 4 ::my(var)
          745  +    catch {set ::my(var) {1 2 3}} my(msg)
          746  +    lappend mylist $my(msg)
          747  +    unset my(msg)
          748  +    set ::my(var) {1 2 3 4}
          749  +    lappend mylist $my(var)
          750  +    testlinkarray remove ::my(var)
          751  +    testlinkarray create -r wide 2 ::my(var)
          752  +    catch {set ::my(var) {1 2}} my(msg)
          753  +    lappend mylist $my(msg)
          754  +    unset my(msg)
          755  +    testlinkarray remove ::my(var)
          756  +    unset my
          757  +    join $mylist "\n"
          758  +} {can't set "::my(var)": variable must have wide integer value
          759  +120
          760  +can't set "::my(var)": variable must have wide integer value
          761  +can't set "::my(var)": wrong dimension
          762  +1 2 3 4
          763  +can't set "::my(var)": linked variable is read-only}
          764  +
          765  +test link-20.1 {linkarray unsigned wide} {
          766  +    set mylist [list]
          767  +    testlinkarray create uwide 1 ::my(var)
          768  +    catch {set ::my(var) x} my(msg)
          769  +    lappend mylist $my(msg)
          770  +    unset my(msg)
          771  +    lappend mylist [set ::my(var) 120]
          772  +    catch {set ::my(var) 1e33} my(msg)
          773  +    lappend mylist $my(msg)
          774  +    unset my(msg)
          775  +    catch {set ::my(var) -1} my(msg)
          776  +    lappend mylist $my(msg)
          777  +    unset my(msg)
          778  +    testlinkarray remove ::my(var)
          779  +    testlinkarray create uwide 4 ::my(var)
          780  +    catch {set ::my(var) {1 2 3}} my(msg)
          781  +    lappend mylist $my(msg)
          782  +    unset my(msg)
          783  +    set ::my(var) {1 2 3 4}
          784  +    lappend mylist $my(var)
          785  +    testlinkarray remove ::my(var)
          786  +    testlinkarray create -r uwide 2 ::my(var)
          787  +    catch {set ::my(var) {1 2}} my(msg)
          788  +    lappend mylist $my(msg)
          789  +    unset my(msg)
          790  +    testlinkarray remove ::my(var)
          791  +    unset my
          792  +    join $mylist "\n"
          793  +} {can't set "::my(var)": variable must have unsigned wide int value
          794  +120
          795  +can't set "::my(var)": variable must have unsigned wide int value
          796  +can't set "::my(var)": variable must have unsigned wide int value
          797  +can't set "::my(var)": wrong dimension
          798  +1 2 3 4
          799  +can't set "::my(var)": linked variable is read-only}
          800  +
          801  +test link-21.1 {linkarray string} {
          802  +    set mylist [list]
          803  +    testlinkarray create string 1 ::my(var)
          804  +    lappend mylist [set ::my(var) ""]
          805  +    lappend mylist [set ::my(var) "xyz"]
          806  +    lappend mylist $::my(var)
          807  +    testlinkarray remove ::my(var)
          808  +    testlinkarray create -r string 4 ::my(var)
          809  +    catch {set ::my(var) x} my(msg)
          810  +    lappend mylist $my(msg)
          811  +    unset my(msg)
          812  +    testlinkarray remove ::my(var)
          813  +    unset my
          814  +    join $mylist "\n"
          815  +} {
          816  +xyz
          817  +xyz
          818  +can't set "::my(var)": linked variable is read-only}
          819  +
          820  +test link-22.1 {linkarray binary} {
          821  +    set mylist [list]
          822  +    testlinkarray create binary 1 ::my(var)
          823  +    set ::my(var) x
          824  +    catch {set ::my(var) xy} my(msg)
          825  +    lappend mylist $my(msg)
          826  +    unset my(msg)
          827  +    lappend mylist $::my(var)
          828  +    testlinkarray remove ::my(var)
          829  +    testlinkarray create binary 4 ::my(var)
          830  +    catch {set ::my(var) abc} my(msg)
          831  +    lappend mylist $my(msg)
          832  +    unset my(msg)
          833  +    catch {set ::my(var) abcde} my(msg)
          834  +    lappend mylist $my(msg)
          835  +    unset my(msg)
          836  +    set ::my(var) abcd
          837  +    lappend mylist $::my(var)
          838  +    testlinkarray remove ::my(var)
          839  +    testlinkarray create -r binary 4 ::my(var)
          840  +    catch {set ::my(var) xyzv} my(msg)
          841  +    lappend mylist $my(msg)
          842  +    unset my(msg)
          843  +    testlinkarray remove ::my(var)
          844  +    unset my
          845  +    join $mylist "\n"
          846  +} {can't set "::my(var)": wrong size of binary value
          847  +x
          848  +can't set "::my(var)": wrong size of binary value
          849  +can't set "::my(var)": wrong size of binary value
          850  +abcd
          851  +can't set "::my(var)": linked variable is read-only}
   401    852   
   402    853   catch {testlink set 0 0 0 - 0 0 0 0 0 0 0 0 0 0}
   403    854   catch {testlink delete}
   404    855   foreach i {int real bool string wide} {
   405    856       unset -nocomplain $i
   406    857   }
   407    858