Tcl Source Code

Check-in [bf63bb7d85]
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:Adapt [array for] to use the refactored routines.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | tip-421
Files: files | file ages | folders
SHA3-256: bf63bb7d852457313ac0f2ec5ea418be58849572e11a41823707818f2aeec282
User & Date: dgp 2018-04-19 17:46:37
Context
2018-04-20
16:02
TIP 421 Implementation. check-in: 7c614b9330 user: dgp tags: core-8-branch
2018-04-19
17:46
Adapt [array for] to use the refactored routines. Closed-Leaf check-in: bf63bb7d85 user: dgp tags: tip-421
17:40
merge 8.7 check-in: 247df44614 user: dgp tags: tip-421
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclVar.c.

3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
....
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097

3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115


3116
3117
3118
3119
3120
3121
3122
static int
ArrayForNRCmd(
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *varListObj, *arrayNameObj, *scriptObj;
    ArraySearch *searchPtr = NULL;
    Var *varPtr;
    Var *arrayPtr;
    int numVars;

    /*
     * array for {k v} a body
     */

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
................................................................................
	return TCL_ERROR;
    }

    /*
     * Parse arguments.
     */


    if (Tcl_ListObjLength(interp, objv[1], &numVars) != TCL_OK) {
	return TCL_ERROR;
    }

    if (numVars != 2) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"must have two variable names", -1));
	Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "array", "for", NULL);
	return TCL_ERROR;
    }

    arrayNameObj = objv[2];

    /*
     * Locate the array variable.
     */

    varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL, /*flags*/ 0,
	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);

    /*
     * Special array trace used to keep the env array in sync for array names,
     * array get, etc.
     */

    if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, arrayNameObj, NULL,
		(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
		TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {

	    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 ((varPtr == NULL) || !TclIsVarArray(varPtr)
	    || TclIsVarUndefined(varPtr)) {
	const char *varName = Tcl_GetString(arrayNameObj);

	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, put it on the stack.
     */

    searchPtr = ckalloc(sizeof(ArraySearch));






<



<
|







 







<













<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
>
|
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
>
>







3039
3040
3041
3042
3043
3044
3045

3046
3047
3048

3049
3050
3051
3052
3053
3054
3055
3056
....
3058
3059
3060
3061
3062
3063
3064

3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077

















3078
3079
3080
3081















3082
3083
3084
3085
3086
3087
3088
3089
3090
static int
ArrayForNRCmd(
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{

    Tcl_Obj *varListObj, *arrayNameObj, *scriptObj;
    ArraySearch *searchPtr = NULL;
    Var *varPtr;

    int isArray, numVars;

    /*
     * array for {k v} a body
     */

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
................................................................................
	return TCL_ERROR;
    }

    /*
     * Parse arguments.
     */


    if (Tcl_ListObjLength(interp, objv[1], &numVars) != TCL_OK) {
	return TCL_ERROR;
    }

    if (numVars != 2) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"must have two variable names", -1));
	Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "array", "for", NULL);
	return TCL_ERROR;
    }

    arrayNameObj = objv[2];


















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
















    if (!isArray) {
	return NotArrayError(interp, arrayNameObj);
    }

    /*
     * Make a new array search, put it on the stack.
     */

    searchPtr = ckalloc(sizeof(ArraySearch));