Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | merge 8.7 |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA3-256: |
06bb3a2bf881b37ea08cd039c3914c94 |
| User & Date: | dgp 2018-04-23 13:53:04 |
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 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 .... 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 .... 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 .... 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 .... 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 3094 3095 .... 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 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 .... 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 .... 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 .... 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 .... 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 .... 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 |
* 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. */
Tcl_Obj *arrayNameObj; /* name of the array object */
} 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 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,
................................................................................
/*
*----------------------------------------------------------------------
*
* ArrayForObjCmd
* ArrayForNRCmd
* ArrayForLoopCallback
* ArrayObjFirst
* 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.
*
................................................................................
*
* 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.
*
* ArrayObjFirst() Does not execute the body or set the key/value variables.
*
*----------------------------------------------------------------------
*/
void
ArrayObjFirst(
Tcl_Interp *interp,
Tcl_Obj *arrayNameObj,
Var *varPtr,
ArraySearch *searchPtr)
{
Interp *iPtr = (Interp *) interp;
Tcl_HashEntry *hPtr;
int isNew;
/* this code is duplicated from arraystartsearchcmd,
excepting that arrayNameObj is set */
searchPtr->varPtr = varPtr;
searchPtr->arrayNameObj = arrayNameObj;
/* add the search to the search table */
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->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);
}
int
ArrayObjNext(
Tcl_Interp *interp,
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.*/
)
................................................................................
return donerc;
}
donerc = TCL_CONTINUE;
keyObj = VarHashGetKey(varPtr);
*keyPtrPtr = keyObj;
valueObj = Tcl_ObjGetVar2(interp, searchPtr->arrayNameObj,
keyObj, TCL_LEAVE_ERR_MSG);
*valuePtrPtr = valueObj;
return donerc;
}
int
................................................................................
}
/*
* Make a new array search, put it on the stack.
*/
searchPtr = ckalloc(sizeof(ArraySearch));
searchPtr->arrayNameObj = NULL;
ArrayObjFirst(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]);
................................................................................
Tcl_IncrRefCount(scriptObj);
/*
* Run the script.
*/
TclNRAddCallback(interp, ArrayForLoopCallback, searchPtr, varListObj,
NULL, 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 *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;
varPtr = TclObjLookupVarEx(interp, searchPtr->arrayNameObj, NULL, /*flags*/ 0,
/*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
if (result == TCL_CONTINUE) {
result = TCL_OK;
} else if (result != TCL_OK) {
if (result == TCL_BREAK) {
Tcl_ResetResult(interp);
result = TCL_OK;
................................................................................
/*
* Get the next mapping from the array.
*/
keyObj = NULL;
valueObj = NULL;
done = ArrayObjNext (interp, 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));
................................................................................
}
/*
* Run the script.
*/
TclNRAddCallback(interp, ArrayForLoopCallback, searchPtr, varListObj,
NULL, scriptObj);
return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);
/*
* For unwinding everything once the iterating is done.
*/
arrayfordone:
................................................................................
}
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
................................................................................
static int
ArrayStartSearchCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
Interp *iPtr = (Interp *)interp;
Var *varPtr;
Tcl_HashEntry *hPtr;
int isNew, isArray;
ArraySearch *searchPtr;
const char *varName;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
return TCL_ERROR;
}
if (TCL_ERROR == LocateArray(interp, objv[1], &varPtr, &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 {
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(objv[1]));
Tcl_IncrRefCount(searchPtr->name);
Tcl_SetObjResult(interp, searchPtr->name);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
< > < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < | > | < | | > < < > > > > > > | > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > < < | < < < < < < < < < < < < < < < < < > |
162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 .... 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 .... 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 .... 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 .... 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 .... 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 .... 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 .... 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 .... 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 .... 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 .... 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 |
* 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,
................................................................................
/*
*----------------------------------------------------------------------
*
* 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.
*
................................................................................
*
* 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.*/
)
................................................................................
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
................................................................................
}
/*
* 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]);
................................................................................
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;
................................................................................
/*
* 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));
................................................................................
}
/*
* 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:
................................................................................
}
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
................................................................................
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 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 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 {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
|
| |
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
|