Tcl Source Code

Check-in [ba72282270]
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:Refactor error reporting when value is not an expected array variable name.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-6-branch
Files: files | file ages | folders
SHA3-256: ba72282270b0d3b513ed52877efbbc9bcd9b7491602910610eeb0f4a8af84578
User & Date: dgp 2018-04-18 23:41:48
Context
2018-04-19
01:41
merge 8.5 check-in: a376926d6e user: dgp tags: core-8-6-branch
2018-04-18
23:41
Refactor error reporting when value is not an expected array variable name. check-in: ba72282270 user: dgp tags: core-8-6-branch
23:31
Refactor to bring the test for existence of an array variable into LocateArray(). check-in: 9af19a47d6 user: dgp tags: core-8-6-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclVar.c.

174
175
176
177
178
179
180

181
182
183
184
185
186
187
...
290
291
292
293
294
295
296













297
298
299
300
301
302
303
....
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170

3171
3172
3173
3174
3175
3176

3177
3178
3179
3180
3181
3182
3183
....
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
....
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330

3331
3332
3333
3334
3335
3336
3337
....
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423

3424
3425
3426
3427
3428
3429
3430
....
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
static void		AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Obj *patternPtr, int includeLinks);
static void		DeleteSearches(Interp *iPtr, Var *arrayVarPtr);
static void		DeleteArray(Interp *iPtr, Tcl_Obj *arrayNamePtr,
			    Var *varPtr, int flags, int index);
static int		LocateArray(Tcl_Interp *interp, Tcl_Obj *name,
			    Var **varPtrPtr, int *isArrayPtr);

static Tcl_Var		ObjFindNamespaceVar(Tcl_Interp *interp,
			    Tcl_Obj *namePtr, Tcl_Namespace *contextNsPtr,
			    int flags);
static int		ObjMakeUpvar(Tcl_Interp *interp,
			    CallFrame *framePtr, Tcl_Obj *otherP1Ptr,
			    const char *otherP2, const int otherFlags,
			    Tcl_Obj *myNamePtr, int myFlags, int index);
................................................................................
    }
    if (isArrayPtr) {
	*isArrayPtr = varPtr && !TclIsVarUndefined(varPtr)
		&& TclIsVarArray(varPtr);
    }
    return TCL_OK;
}













 
/*
 *----------------------------------------------------------------------
 *
 * TclCleanupVar --
 *
 *	This function is called when it looks like it may be OK to free up a
................................................................................
	return TCL_ERROR;
    }

    if (TCL_ERROR == LocateArray(interp, objv[1], &varPtr, &isArray)) {
	return TCL_ERROR;
    }

    varName = TclGetString(objv[1]);
    if (!isArray) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"%s\" isn't an array", varName));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", varName, NULL);
	return TCL_ERROR;

    }

    /*
     * Make a new array search with a free name.
     */


    searchPtr = ckalloc(sizeof(ArraySearch));
    hPtr = Tcl_CreateHashEntry(&iPtr->varSearches, varPtr, &isNew);
    if (isNew) {
	searchPtr->id = 1;
	varPtr->flags |= VAR_SEARCH_ACTIVE;
	searchPtr->nextPtr = NULL;
    } else {
................................................................................
    searchObj = objv[2];

    if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
	return TCL_ERROR;
    }

    if (!isArray) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"%s\" isn't an array", TclGetString(varNameObj)));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
		TclGetString(varNameObj), NULL);
	return TCL_ERROR;
    }

    /*
     * Get the search.
     */

    searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj);
................................................................................
    varNameObj = objv[1];
    searchObj = objv[2];

    if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
	return TCL_ERROR;
    }

    /*
     * Verify that it is indeed an array variable. This test comes after the
     * traces - the variable may actually become an array as an effect of said
     * traces.
     */
    if (!isArray) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"%s\" isn't an array", TclGetString(varNameObj)));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
		TclGetString(varNameObj), NULL);
	return TCL_ERROR;

    }

    /*
     * Get the search.
     */

    searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj);
................................................................................
    varNameObj = objv[1];
    searchObj = objv[2];

    if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
	return TCL_ERROR;
    }

    /*
     * Verify that it is indeed an array variable. This test comes after the
     * traces - the variable may actually become an array as an effect of said
     * traces.
     */

    if (!isArray) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"%s\" isn't an array", TclGetString(varNameObj)));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
		TclGetString(varNameObj), NULL);
	return TCL_ERROR;

    }

    /*
     * Get the search.
     */

    searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj);
................................................................................
    varNameObj = objv[1];

    if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
	return TCL_ERROR;
    }

    if (!isArray) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"%s\" isn't an array", TclGetString(varNameObj)));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
		TclGetString(varNameObj), NULL);
	return TCL_ERROR;
    }

    stats = Tcl_HashStats((Tcl_HashTable *) varPtr->value.tablePtr);
    if (stats == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"error reading array statistics", -1));
	return TCL_ERROR;






>







 







>
>
>
>
>
>
>
>
>
>
>
>
>







 







<

<
<
<
<
>






>







 







|
<
<
<
<







 







<
<
<
<
<

<
<
<
<
<
>







 







<
<
<
<
<
<

<
<
<
<
<
>







 







|
<
<
<
<







174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
...
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
....
3172
3173
3174
3175
3176
3177
3178

3179




3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
....
3243
3244
3245
3246
3247
3248
3249
3250




3251
3252
3253
3254
3255
3256
3257
....
3320
3321
3322
3323
3324
3325
3326





3327





3328
3329
3330
3331
3332
3333
3334
3335
....
3403
3404
3405
3406
3407
3408
3409






3410





3411
3412
3413
3414
3415
3416
3417
3418
....
3948
3949
3950
3951
3952
3953
3954
3955




3956
3957
3958
3959
3960
3961
3962
static void		AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Obj *patternPtr, int includeLinks);
static void		DeleteSearches(Interp *iPtr, Var *arrayVarPtr);
static void		DeleteArray(Interp *iPtr, Tcl_Obj *arrayNamePtr,
			    Var *varPtr, int flags, int index);
static int		LocateArray(Tcl_Interp *interp, Tcl_Obj *name,
			    Var **varPtrPtr, int *isArrayPtr);
static int		NotArrayError(Tcl_Interp *interp, Tcl_Obj *name);
static Tcl_Var		ObjFindNamespaceVar(Tcl_Interp *interp,
			    Tcl_Obj *namePtr, Tcl_Namespace *contextNsPtr,
			    int flags);
static int		ObjMakeUpvar(Tcl_Interp *interp,
			    CallFrame *framePtr, Tcl_Obj *otherP1Ptr,
			    const char *otherP2, const int otherFlags,
			    Tcl_Obj *myNamePtr, int myFlags, int index);
................................................................................
    }
    if (isArrayPtr) {
	*isArrayPtr = varPtr && !TclIsVarUndefined(varPtr)
		&& TclIsVarArray(varPtr);
    }
    return TCL_OK;
}

static int
NotArrayError(
    Tcl_Interp *interp,
    Tcl_Obj *name)
{
    const char *nameStr = Tcl_GetString(name);

    Tcl_SetObjResult(interp,
	    Tcl_ObjPrintf("\"%s\" isn't an array", nameStr));
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", nameStr, NULL);
    return TCL_ERROR;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclCleanupVar --
 *
 *	This function is called when it looks like it may be OK to free up a
................................................................................
	return TCL_ERROR;
    }

    if (TCL_ERROR == LocateArray(interp, objv[1], &varPtr, &isArray)) {
	return TCL_ERROR;
    }


    if (!isArray) {




	return NotArrayError(interp, objv[1]);
    }

    /*
     * Make a new array search with a free name.
     */

    varName = TclGetString(objv[1]);
    searchPtr = ckalloc(sizeof(ArraySearch));
    hPtr = Tcl_CreateHashEntry(&iPtr->varSearches, varPtr, &isNew);
    if (isNew) {
	searchPtr->id = 1;
	varPtr->flags |= VAR_SEARCH_ACTIVE;
	searchPtr->nextPtr = NULL;
    } else {
................................................................................
    searchObj = objv[2];

    if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
	return TCL_ERROR;
    }

    if (!isArray) {
	return NotArrayError(interp, varNameObj);




    }

    /*
     * Get the search.
     */

    searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj);
................................................................................
    varNameObj = objv[1];
    searchObj = objv[2];

    if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
	return TCL_ERROR;
    }






    if (!isArray) {





	return NotArrayError(interp, varNameObj);
    }

    /*
     * Get the search.
     */

    searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj);
................................................................................
    varNameObj = objv[1];
    searchObj = objv[2];

    if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
	return TCL_ERROR;
    }







    if (!isArray) {





	return NotArrayError(interp, varNameObj);
    }

    /*
     * Get the search.
     */

    searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj);
................................................................................
    varNameObj = objv[1];

    if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
	return TCL_ERROR;
    }

    if (!isArray) {
	return NotArrayError(interp, varNameObj);




    }

    stats = Tcl_HashStats((Tcl_HashTable *) varPtr->value.tablePtr);
    if (stats == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"error reading array statistics", -1));
	return TCL_ERROR;