Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | merge 8.7 |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA3-256: |
06bb3a2bf881b37ea08cd039c3914c94 |
User & Date: | dgp 2018-04-23 13:53:04.358 |
Context
2018-04-23
| ||
15:07 | merge 8.7 check-in: aaa3ab6a72 user: jan.nijtmans tags: trunk | |
13:53 | merge 8.7 check-in: 06bb3a2bf8 user: dgp tags: trunk | |
13:51 | Dup test name. check-in: c1cfcdbc3a user: dgp tags: core-8-branch | |
2018-04-22
| ||
13:28 | merge 8.7 check-in: 26d8195372 user: dgp tags: trunk | |
Changes
Changes to generic/tclVar.c.
︙ | ︙ | |||
162 163 164 165 166 167 168 | * Tcl_FirstHashEntry call or from an "array * anymore" command). NULL means must call * Tcl_NextHashEntry to get value to * return. */ struct ArraySearch *nextPtr;/* Next in list of all active searches for * this variable, or NULL if this is the last * one. */ | < > | 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 | * Tcl_FirstHashEntry call or from an "array * anymore" command). NULL means must call * Tcl_NextHashEntry to get value to * return. */ struct ArraySearch *nextPtr;/* Next in list of all active searches for * this variable, or NULL if this is the last * one. */ } ArraySearch; /* * Forward references to functions defined later in this file: */ static void AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *patternPtr, int includeLinks); static void ArrayPopulateSearch(Tcl_Interp *interp, Tcl_Obj *arrayNameObj, Var *varPtr, ArraySearch *searchPtr); static void ArrayDoneSearch (Interp *iPtr, Var *varPtr, ArraySearch *searchPtr); static Tcl_NRPostProc ArrayForLoopCallback; static int ArrayForNRCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); 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, |
︙ | ︙ | |||
2904 2905 2906 2907 2908 2909 2910 | /* *---------------------------------------------------------------------- * * ArrayForObjCmd * ArrayForNRCmd * ArrayForLoopCallback | < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < | > | 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 | /* *---------------------------------------------------------------------- * * ArrayForObjCmd * ArrayForNRCmd * ArrayForLoopCallback * ArrayObjNext * * These functions implement the "array for" Tcl command. * array for {k v} a {} * The array for command iterates over the array, setting the * the specified loop variables, and executing the body each iteration. * * ArrayForObjCmd() is the standard wrapper around ArrayForNRCmd(). * * ArrayForNRCmd() sets up the ArraySearch structure, sets arrayNamePtr * inside the structure and calls VarHashFirstEntry to start the hash * iteration. * * ArrayForNRCmd() does not execute the body or set the loop variables, * it only initializes the iterator. * * ArrayForLoopCallback() iterates over the entire array, executing * the body each time. * *---------------------------------------------------------------------- */ static int ArrayObjNext( Tcl_Interp *interp, Tcl_Obj *arrayNameObj, /* array */ Var *varPtr, /* array */ ArraySearch *searchPtr, Tcl_Obj **keyPtrPtr, /* Pointer to a variable to have the key * written into, or NULL. */ Tcl_Obj **valuePtrPtr /* Pointer to a variable to have the * value written into, or NULL.*/ ) |
︙ | ︙ | |||
3011 3012 3013 3014 3015 3016 3017 | return donerc; } donerc = TCL_CONTINUE; keyObj = VarHashGetKey(varPtr); *keyPtrPtr = keyObj; | | | 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 | return donerc; } donerc = TCL_CONTINUE; keyObj = VarHashGetKey(varPtr); *keyPtrPtr = keyObj; valueObj = Tcl_ObjGetVar2(interp, arrayNameObj, keyObj, TCL_LEAVE_ERR_MSG); *valuePtrPtr = valueObj; return donerc; } int |
︙ | ︙ | |||
3080 3081 3082 3083 3084 3085 3086 | } /* * Make a new array search, put it on the stack. */ searchPtr = ckalloc(sizeof(ArraySearch)); | < | | > < < | 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 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 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 | } /* * Make a new array search, put it on the stack. */ searchPtr = ckalloc(sizeof(ArraySearch)); ArrayPopulateSearch (interp, arrayNameObj, varPtr, searchPtr); /* * Make sure that these objects (which we need throughout the body of the * loop) don't vanish. */ varListObj = TclListObjCopy(NULL, objv[1]); scriptObj = objv[3]; Tcl_IncrRefCount(scriptObj); /* * Run the script. */ TclNRAddCallback(interp, ArrayForLoopCallback, searchPtr, varListObj, arrayNameObj, scriptObj); return TCL_OK; } static int ArrayForLoopCallback( ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; ArraySearch *searchPtr = data[0]; Tcl_Obj *varListObj = data[1]; Tcl_Obj *arrayNameObj = data[2]; Tcl_Obj *scriptObj = data[3]; Tcl_Obj **varv; Tcl_Obj *keyObj, *valueObj; Var *varPtr; Var *arrayPtr; int done, varc; /* * Process the result from the previous execution of the script body. */ done = TCL_ERROR; if (result == TCL_CONTINUE) { result = TCL_OK; } else if (result != TCL_OK) { if (result == TCL_BREAK) { Tcl_ResetResult(interp); result = TCL_OK; |
︙ | ︙ | |||
3145 3146 3147 3148 3149 3150 3151 | /* * Get the next mapping from the array. */ keyObj = NULL; valueObj = NULL; | > > > > > | > > | 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 | /* * Get the next mapping from the array. */ keyObj = NULL; valueObj = NULL; varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL, /*flags*/ 0, /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr); if (varPtr == NULL) { done = TCL_ERROR; } else { done = ArrayObjNext (interp, arrayNameObj, varPtr, searchPtr, &keyObj, &valueObj); } result = TCL_OK; if (done != TCL_CONTINUE) { Tcl_ResetResult(interp); if (done == TCL_ERROR) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "array changed during iteration", -1)); |
︙ | ︙ | |||
3177 3178 3179 3180 3181 3182 3183 | } /* * Run the script. */ TclNRAddCallback(interp, ArrayForLoopCallback, searchPtr, varListObj, | | | 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 | } /* * Run the script. */ TclNRAddCallback(interp, ArrayForLoopCallback, searchPtr, varListObj, arrayNameObj, scriptObj); return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3); /* * For unwinding everything once the iterating is done. */ arrayfordone: |
︙ | ︙ | |||
3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 | } TclDecrRefCount(varListObj); TclDecrRefCount(scriptObj); return result; } /* *---------------------------------------------------------------------- * * ArrayStartSearchCmd -- * * This object-based function is invoked to process the "array * startsearch" Tcl command. See the user documentation for details on | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 | } TclDecrRefCount(varListObj); TclDecrRefCount(scriptObj); return result; } /* * ArrayPopulateSearch */ static void ArrayPopulateSearch( Tcl_Interp *interp, Tcl_Obj *arrayNameObj, Var *varPtr, ArraySearch *searchPtr) { Interp *iPtr = (Interp *)interp; Tcl_HashEntry *hPtr; int isNew; hPtr = Tcl_CreateHashEntry(&iPtr->varSearches, varPtr, &isNew); if (isNew) { searchPtr->id = 1; varPtr->flags |= VAR_SEARCH_ACTIVE; searchPtr->nextPtr = NULL; } else { searchPtr->id = ((ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1; searchPtr->nextPtr = Tcl_GetHashValue(hPtr); } searchPtr->varPtr = varPtr; searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr, &searchPtr->search); Tcl_SetHashValue(hPtr, searchPtr); searchPtr->name = Tcl_ObjPrintf("s-%d-%s", searchPtr->id, TclGetString(arrayNameObj)); Tcl_IncrRefCount(searchPtr->name); } /* *---------------------------------------------------------------------- * * ArrayStartSearchCmd -- * * This object-based function is invoked to process the "array * startsearch" Tcl command. See the user documentation for details on |
︙ | ︙ | |||
3226 3227 3228 3229 3230 3231 3232 | static int ArrayStartSearchCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { | < < | < < < < < < < < < < < < < < | < < | 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 | static int ArrayStartSearchCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Var *varPtr; int isArray; ArraySearch *searchPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "arrayName"); 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. */ searchPtr = ckalloc(sizeof(ArraySearch)); ArrayPopulateSearch (interp, objv[1], varPtr, searchPtr); Tcl_SetObjResult(interp, searchPtr->name); return TCL_OK; } /* *---------------------------------------------------------------------- * |
︙ | ︙ |
Changes to tests/string.test.
︙ | ︙ | |||
483 484 485 486 487 488 489 | } -match glob -result {1 {*}} test string-5.19.$noComp {string index, bytearray object out of bounds} { run {string index [binary format I* {0x50515253 0x52}] -1} } {} test string-5.20.$noComp {string index, bytearray object out of bounds} { run {string index [binary format I* {0x50515253 0x52}] 20} } {} | | | 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 | } -match glob -result {1 {*}} test string-5.19.$noComp {string index, bytearray object out of bounds} { run {string index [binary format I* {0x50515253 0x52}] -1} } {} test string-5.20.$noComp {string index, bytearray object out of bounds} { run {string index [binary format I* {0x50515253 0x52}] 20} } {} test string-5.21.$noComp {string index, surrogates, bug [11ae2be95dac9417]} fullutf { list [string index a\U100000b 1] [string index a\U100000b 2] [string index a\U100000b 3] } [list \U100000 {} b] proc largest_int {} { # This will give us what the largest valid int on this machine is, # so we can test for overflow properly below on >32 bit systems |
︙ | ︙ |