Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | merge trunk |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | mig-no280 |
Files: | files | file ages | folders |
SHA1: |
91f0cc8fa7bff9ee349119489b60384c |
User & Date: | mig 2011-04-19 14:24:37 |
Context
2011-05-07
| ||
20:39 | merge trunk check-in: eeefcef28f user: mig tags: mig-no280 | |
2011-04-19
| ||
14:24 | merge trunk check-in: 91f0cc8fa7 user: mig tags: mig-no280 | |
08:04 | This time, I'll try to get it right! check-in: ef35e2c747 user: dkf tags: trunk | |
2011-04-11
| ||
11:09 | merge trunk check-in: b936648e57 user: mig tags: mig-no280 | |
Changes
Changes to ChangeLog.
1 2 3 | 2011-04-11 Miguel Sofer <[email protected]> * generic/tclBasic.c: | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | > | | | | > > > | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 | 2011-04-16 Donal K. Fellows <[email protected]> * generic/tclFCmd.c (TclFileAttrsCmd): Add comments to make this code easier to understand. Added a panic to handle the case where the VFS layer does something odd. 2011-04-13 Don Porter <[email protected]> * generic/tclUtil.c: [Bug 3285375]: Rewrite of Tcl_Concat*() routines to prevent segfaults on buffer overflow. Build them out of existing primitives already coded to handle overflow properly. Uses the new TclTrim*() routines. * generic/tclCmdMZ.c: New internal utility routines TclTrimLeft() * generic/tclInt.h: and TclTrimRight(). Refactor the * generic/tclUtil.c: [string trim*] implementations to use them. 2011-04-13 Miguel Sofer <[email protected]> * generic/tclVar.c: [Bug 2662380]: Fix crash caused by appending to a variable with a write trace that unsets it. 2011-04-13 Donal K. Fellows <[email protected]> * generic/tclUtil.c (Tcl_ConcatObj): [Bug 3285375]: Make the crash less mysterious through the judicious use of a panic. Not yet properly fixed, but at least now clearer what the failure mode is. 2011-04-12 Don Porter <[email protected]> * tests/string.test: Test for [Bug 3285472]. Not buggy in trunk. 2011-04-12 Venkat Iyer <[email protected]> * library/tzdata/Atlantic/Stanley: Update to Olson tzdata2011f 2011-04-12 Miguel Sofer <[email protected]> * generic/tclBasic.c: Fix for [Bug 2440625], kbk's patch 2011-04-11 Miguel Sofer <[email protected]> * generic/tclBasic.c: * tests/coroutine.test: [Bug 3282869]: Ensure that 'coroutine eval' runs the initial command in the proper context. 2011-04-11 Jan Nijtmans <[email protected]> * generic/tcl.h: Fix for [Bug 3281728]: Tcl sources from 2011-04-06 * unix/tcl.m4: do not build on GCC9 (RH9) * unix/configure: 2011-04-08 Jan Nijtmans <[email protected]> * win/tclWinPort.h: Fix for [Bug 3280043]: win2k: unresolved DLL * win/configure.in: imports. * win/configure 2011-04-06 Miguel Sofer <[email protected]> * generic/tclExecute.c (TclCompileObj): Earlier return if Tip280 gymnastics not needed. * generic/tclExecute.c: Fix for [Bug 3274728]: making *catchTop an unsigned long. 2011-04-06 Jan Nijtmans <[email protected]> * unix/tclAppInit.c: Make symbols "main" and "Tcl_AppInit" MODULE_SCOPE: there is absolutely no reason for exporting them. * unix/tcl.m4: Don't use -fvisibility=hidden with static * unix/configure libraries (--disable-shared) |
︙ | ︙ |
Changes to doc/dict.n.
︙ | ︙ | |||
63 64 65 66 67 68 69 | argument after the rule selection word is a two-element list. If the \fIscript\fR returns with a condition of \fBTCL_BREAK\fR, no further key/value pairs are considered for inclusion in the resulting dictionary, and a condition of \fBTCL_CONTINUE\fR is equivalent to a false result. The key/value pairs are tested in the order in which the keys were inserted into the dictionary. .TP | | | 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 | argument after the rule selection word is a two-element list. If the \fIscript\fR returns with a condition of \fBTCL_BREAK\fR, no further key/value pairs are considered for inclusion in the resulting dictionary, and a condition of \fBTCL_CONTINUE\fR is equivalent to a false result. The key/value pairs are tested in the order in which the keys were inserted into the dictionary. .TP \fBdict filter \fIdictionaryValue \fBvalue \fR?\fIglobPattern ...\fR? .VS 8.6 The value rule only matches those key/value pairs whose values match any of the given patterns (in the style of \fBstring match\fR.) .VE 8.6 .RE .TP \fBdict for {\fIkeyVar valueVar\fB} \fIdictionaryValue body\fR |
︙ | ︙ |
Changes to generic/tcl.h.
︙ | ︙ | |||
369 370 371 372 373 374 375 | * * Note on converting between Tcl_WideInt and strings. This implementation (in * tclObj.c) depends on the function * sprintf(...,"%" TCL_LL_MODIFIER "d",...). */ #if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG) | | < < < < < < < < | > > > > | 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 | * * Note on converting between Tcl_WideInt and strings. This implementation (in * tclObj.c) depends on the function * sprintf(...,"%" TCL_LL_MODIFIER "d",...). */ #if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG) # if defined(__WIN32__) # define TCL_WIDE_INT_TYPE __int64 # ifdef __BORLANDC__ typedef struct stati64 Tcl_StatBuf; # define TCL_LL_MODIFIER "L" # else /* __BORLANDC__ */ # if (defined(_MSC_VER) && (_MSC_VER < 1400)) || !defined(_M_IX86) || defined(__GNUC__) typedef struct _stati64 Tcl_StatBuf; # else typedef struct _stat64 Tcl_StatBuf; # endif /* _MSC_VER < 1400 */ # define TCL_LL_MODIFIER "I64" # endif /* __BORLANDC__ */ # elif defined(__GNUC__) # define TCL_WIDE_INT_TYPE long long # define TCL_LL_MODIFIER "ll" typedef struct stat Tcl_StatBuf; # else /* __WIN32__ */ /* * Don't know what platform it is and configure hasn't discovered what is * going on for us. Try to guess... */ # ifdef NO_LIMITS_H # error please define either TCL_WIDE_INT_TYPE or TCL_WIDE_INT_IS_LONG |
︙ | ︙ |
Changes to generic/tclBasic.c.
︙ | ︙ | |||
4170 4171 4172 4173 4174 4175 4176 | cmdPtr->refCount++; /* * Find the objProc to call: nreProc if available, objProc otherwise. Push * a callback to do the actual running. */ | < < < < < < < < < < < < < | | < | 4170 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 4188 4189 4190 | cmdPtr->refCount++; /* * Find the objProc to call: nreProc if available, objProc otherwise. Push * a callback to do the actual running. */ if (cmdPtr->nreProc) { TclNRAddCallback(interp, NRRunObjProc, cmdPtr, INT2PTR(objc), (ClientData) objv, NULL); return TCL_OK; } else { return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv); } } void TclPushTailcallPoint( Tcl_Interp *interp) { TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL); |
︙ | ︙ | |||
4278 4279 4280 4281 4282 4283 4284 | NRRunObjProc( ClientData data[], Tcl_Interp *interp, int result) { /* OPT: do not call? */ | < | | | < | < < | 4264 4265 4266 4267 4268 4269 4270 4271 4272 4273 4274 4275 4276 4277 4278 4279 4280 4281 4282 | NRRunObjProc( ClientData data[], Tcl_Interp *interp, int result) { /* OPT: do not call? */ Command* cmdPtr = data[0]; int objc = PTR2INT(data[1]); Tcl_Obj **objv = data[2]; return cmdPtr->nreProc(cmdPtr->objClientData, interp, objc, objv); } /* *---------------------------------------------------------------------- * * TEOV_Exception - |
︙ | ︙ | |||
5172 5173 5174 5175 5176 5177 5178 | * execute. */ int flags) /* Collection of OR-ed bits that control the * evaluation of the script. Supported values * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */ { Interp *iPtr = (Interp *) interp; int result; | < < < | | 5154 5155 5156 5157 5158 5159 5160 5161 5162 5163 5164 5165 5166 5167 5168 5169 5170 5171 5172 5173 5174 5175 | * execute. */ int flags) /* Collection of OR-ed bits that control the * evaluation of the script. Supported values * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */ { Interp *iPtr = (Interp *) interp; int result; /* * This function consists of three independent blocks for: direct * evaluation of canonical lists, compileation and bytecode execution and * finally direct evaluation. Precisely one of these blocks will be run. */ if (TclListObjIsCanonical(objPtr)) { Tcl_Obj *listPtr = objPtr; int objc; Tcl_Obj **objv; /* * Pure List Optimization (no string representation). In this case, we * can safely use Tcl_EvalObjv instead and get an appreciable |
︙ | ︙ |
Changes to generic/tclCmdIL.c.
︙ | ︙ | |||
1325 1326 1327 1328 1329 1330 1331 | InfoLoadedCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *interpName; | < | < | 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 | InfoLoadedCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *interpName; if ((objc != 1) && (objc != 2)) { Tcl_WrongNumArgs(interp, 1, objv, "?interp?"); return TCL_ERROR; } if (objc == 1) { /* Get loaded pkgs in all interpreters. */ interpName = NULL; } else { /* Get pkgs just in specified interp. */ interpName = TclGetString(objv[1]); } return TclGetLoadedPackages(interp, interpName); } /* *---------------------------------------------------------------------- * * InfoNameOfExecutableCmd -- * |
︙ | ︙ | |||
2161 2162 2163 2164 2165 2166 2167 | result = TclListObjGetElements(interp, objv[1], &listLen, &elemPtrs); if (result != TCL_OK) { return result; } if (Tcl_IsShared(objv[1]) || | | | 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 | result = TclListObjGetElements(interp, objv[1], &listLen, &elemPtrs); if (result != TCL_OK) { return result; } if (Tcl_IsShared(objv[1]) || ((ListRepPtr(objv[1])->refCount > 1))) { Tcl_SetObjResult(interp, Tcl_NewListObj(last - first + 1, &elemPtrs[first])); } else { /* * In-place is possible. */ |
︙ | ︙ | |||
2266 2267 2268 2269 2270 2271 2272 | /* * Get an empty list object that is allocated large enough to hold each * init value elementCount times. */ listPtr = Tcl_NewListObj(totalElems, NULL); if (totalElems) { | | | 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 | /* * Get an empty list object that is allocated large enough to hold each * init value elementCount times. */ listPtr = Tcl_NewListObj(totalElems, NULL); if (totalElems) { List *listRepPtr = ListRepPtr(listPtr); listRepPtr->elemCount = elementCount*objc; dataArray = &listRepPtr->elements; } /* * Set the elements. Note that we handle the common degenerate case of a |
︙ | ︙ | |||
2455 2456 2457 2458 2459 2460 2461 | */ if (!elemc) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } | | > | < | | | < < < < < < < < < | 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 | */ if (!elemc) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } if (Tcl_IsShared(objv[1]) || (ListRepPtr(objv[1])->refCount > 1)) { /* Bug 1675044 */ Tcl_Obj *resultObj, **dataArray; List *listRepPtr; resultObj = Tcl_NewListObj(elemc, NULL); listRepPtr = ListRepPtr(resultObj); listRepPtr->elemCount = elemc; dataArray = &listRepPtr->elements; for (i=0,j=elemc-1 ; i<elemc ; i++,j--) { dataArray[j] = elemv[i]; Tcl_IncrRefCount(elemv[i]); } Tcl_SetObjResult(interp, resultObj); } else { /* * Not shared, so swap "in place". This relies on Tcl_LOGE above * returning a pointer to the live array of Tcl_Obj values. */ for (i=0,j=elemc-1 ; i<j ; i++,j--) { |
︙ | ︙ | |||
3665 3666 3667 3668 3669 3670 3671 | */ if (sortInfo.resultCode == TCL_OK) { List *listRepPtr; Tcl_Obj **newArray, *objPtr; resultPtr = Tcl_NewListObj(sortInfo.numElements * groupSize, NULL); | | | 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 | */ if (sortInfo.resultCode == TCL_OK) { List *listRepPtr; Tcl_Obj **newArray, *objPtr; resultPtr = Tcl_NewListObj(sortInfo.numElements * groupSize, NULL); listRepPtr = ListRepPtr(resultPtr); newArray = &listRepPtr->elements; if (group) { for (i=0; elementPtr!=NULL ; elementPtr=elementPtr->nextPtr) { idx = elementPtr->payload.index; for (j = 0; j < groupSize; j++) { if (indices) { objPtr = Tcl_NewIntObj(idx + j - groupOffset); |
︙ | ︙ |
Changes to generic/tclCmdMZ.c.
︙ | ︙ | |||
3106 3107 3108 3109 3110 3111 3112 | static int StringTrimCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | < < | | < < < < < < < | < < < | < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | > | 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 3138 | static int StringTrimCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *string2; int triml, trimr, length1, length2; if (objc == 3) { string2 = TclGetStringFromObj(objv[2], &length2); } else if (objc == 2) { string2 = DEFAULT_TRIM_SET; length2 = strlen(DEFAULT_TRIM_SET); } else { Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?"); return TCL_ERROR; } string1 = TclGetStringFromObj(objv[1], &length1); triml = TclTrimLeft(string1, length1, string2, length2); trimr = TclTrimRight(string1 + triml, length1 - triml, string2, length2); Tcl_SetObjResult(interp, Tcl_NewStringObj(string1 + triml, length1 - triml - trimr)); return TCL_OK; } /* *---------------------------------------------------------------------- * * StringTrimLCmd -- |
︙ | ︙ | |||
3202 3203 3204 3205 3206 3207 3208 | static int StringTrimLCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | < < | | < < < < < < < | < < < < < < < < < < < < < < < < < | | 3154 3155 3156 3157 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 3184 | static int StringTrimLCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *string2; int trim, length1, length2; if (objc == 3) { string2 = TclGetStringFromObj(objv[2], &length2); } else if (objc == 2) { string2 = DEFAULT_TRIM_SET; length2 = strlen(DEFAULT_TRIM_SET); } else { Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?"); return TCL_ERROR; } string1 = TclGetStringFromObj(objv[1], &length1); trim = TclTrimLeft(string1, length1, string2, length2); Tcl_SetObjResult(interp, Tcl_NewStringObj(string1+trim, length1-trim)); return TCL_OK; } /* *---------------------------------------------------------------------- * * StringTrimRCmd -- |
︙ | ︙ | |||
3274 3275 3276 3277 3278 3279 3280 | static int StringTrimRCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | < < | | < < < < < < | < < < < < < < < < | < < < < < < < < | | 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 | static int StringTrimRCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *string2; int trim, length1, length2; if (objc == 3) { string2 = TclGetStringFromObj(objv[2], &length2); } else if (objc == 2) { string2 = DEFAULT_TRIM_SET; length2 = strlen(DEFAULT_TRIM_SET); } else { Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?"); return TCL_ERROR; } string1 = TclGetStringFromObj(objv[1], &length1); trim = TclTrimRight(string1, length1, string2, length2); Tcl_SetObjResult(interp, Tcl_NewStringObj(string1, length1-trim)); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclInitStringCmd -- |
︙ | ︙ |
Changes to generic/tclConfig.c.
︙ | ︙ | |||
273 274 275 276 277 278 279 | Tcl_SetResult(interp, "insufficient memory to create list", TCL_STATIC); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } if (n) { | | < | 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 | Tcl_SetResult(interp, "insufficient memory to create list", TCL_STATIC); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } if (n) { List *listRepPtr = ListRepPtr(listPtr); Tcl_DictSearch s; Tcl_Obj *key, **vals; int done, i = 0; listRepPtr->elemCount = n; vals = &listRepPtr->elements; |
︙ | ︙ |
Changes to generic/tclFCmd.c.
︙ | ︙ | |||
962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 | } objc -= 2; objv += 2; result = TCL_ERROR; Tcl_SetErrno(0); attributeStrings = Tcl_FSFileAttrStrings(filePtr, &objStrings); if (attributeStrings == NULL) { int index; Tcl_Obj *objPtr; if (objStrings == NULL) { if (Tcl_GetErrno() != 0) { /* * There was an error, probably that the filePtr is not * accepted by any filesystem */ Tcl_AppendResult(interp, "could not read \"", TclGetString(filePtr), "\": ", Tcl_PosixError(interp), NULL); | > > > > < < > | 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 | } objc -= 2; objv += 2; result = TCL_ERROR; Tcl_SetErrno(0); /* * Get the set of attribute names from the filesystem. */ attributeStrings = Tcl_FSFileAttrStrings(filePtr, &objStrings); if (attributeStrings == NULL) { int index; Tcl_Obj *objPtr; if (objStrings == NULL) { if (Tcl_GetErrno() != 0) { /* * There was an error, probably that the filePtr is not * accepted by any filesystem */ Tcl_AppendResult(interp, "could not read \"", TclGetString(filePtr), "\": ", Tcl_PosixError(interp), NULL); } return TCL_ERROR; } /* * We own the object now. */ Tcl_IncrRefCount(objStrings); |
︙ | ︙ | |||
1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 | TclStackAlloc(interp, (1+numObjStrings) * sizeof(char *)); for (index = 0; index < numObjStrings; index++) { Tcl_ListObjIndex(interp, objStrings, index, &objPtr); attributeStringsAllocated[index] = TclGetString(objPtr); } attributeStringsAllocated[index] = NULL; attributeStrings = attributeStringsAllocated; } if (objc == 0) { /* * Get all attributes. */ int index, res = TCL_OK, nbAtts = 0; Tcl_Obj *listPtr; | > > > > > > > > > | 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 | TclStackAlloc(interp, (1+numObjStrings) * sizeof(char *)); for (index = 0; index < numObjStrings; index++) { Tcl_ListObjIndex(interp, objStrings, index, &objPtr); attributeStringsAllocated[index] = TclGetString(objPtr); } attributeStringsAllocated[index] = NULL; attributeStrings = attributeStringsAllocated; } else if (objStrings != NULL) { Tcl_Panic("must not update objPtrRef's variable and return non-NULL"); } /* * Process the attributes to produce a list of all of them, the value of a * particular attribute, or to set one or more attributes (depending on * the number of arguments). */ if (objc == 0) { /* * Get all attributes. */ int index, res = TCL_OK, nbAtts = 0; Tcl_Obj *listPtr; |
︙ | ︙ | |||
1110 1111 1112 1113 1114 1115 1116 | objv[i + 1]) != TCL_OK) { goto end; } } } result = TCL_OK; | < < | | > | > > | < < < < | | < | 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 | objv[i + 1]) != TCL_OK) { goto end; } } } result = TCL_OK; /* * Free up the array we allocated and drop our reference to any list of * attribute names issued by the filesystem. */ end: if (attributeStringsAllocated != NULL) { TclStackFree(interp, (void *) attributeStringsAllocated); } if (objStrings != NULL) { Tcl_DecrRefCount(objStrings); } return result; } /* *---------------------------------------------------------------------- * |
︙ | ︙ |
Changes to generic/tclInt.h.
︙ | ︙ | |||
2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 | #define ListObjGetElements(listPtr, objc, objv) \ ((objv) = &(ListRepPtr(listPtr)->elements), \ (objc) = ListRepPtr(listPtr)->elemCount) #define ListObjLength(listPtr, len) \ ((len) = ListRepPtr(listPtr)->elemCount) #define TclListObjGetElements(interp, listPtr, objcPtr, objvPtr) \ (((listPtr)->typePtr == &tclListType) \ ? ((ListObjGetElements((listPtr), *(objcPtr), *(objvPtr))), TCL_OK)\ : Tcl_ListObjGetElements((interp), (listPtr), (objcPtr), (objvPtr))) #define TclListObjLength(interp, listPtr, lenPtr) \ (((listPtr)->typePtr == &tclListType) \ ? ((ListObjLength((listPtr), *(lenPtr))), TCL_OK)\ : Tcl_ListObjLength((interp), (listPtr), (lenPtr))) /* * Macros providing a faster path to integers: Tcl_GetLongFromObj everywhere, * Tcl_GetIntFromObj and TclGetIntForIndex on platforms where longs are ints. * * WARNING: these macros eval their args more than once. */ | > > > > > > | 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 | #define ListObjGetElements(listPtr, objc, objv) \ ((objv) = &(ListRepPtr(listPtr)->elements), \ (objc) = ListRepPtr(listPtr)->elemCount) #define ListObjLength(listPtr, len) \ ((len) = ListRepPtr(listPtr)->elemCount) #define ListObjIsCanonical(listPtr) \ (((listPtr)->bytes == NULL) || ListRepPtr(listPtr)->canonicalFlag) #define TclListObjGetElements(interp, listPtr, objcPtr, objvPtr) \ (((listPtr)->typePtr == &tclListType) \ ? ((ListObjGetElements((listPtr), *(objcPtr), *(objvPtr))), TCL_OK)\ : Tcl_ListObjGetElements((interp), (listPtr), (objcPtr), (objvPtr))) #define TclListObjLength(interp, listPtr, lenPtr) \ (((listPtr)->typePtr == &tclListType) \ ? ((ListObjLength((listPtr), *(lenPtr))), TCL_OK)\ : Tcl_ListObjLength((interp), (listPtr), (lenPtr))) #define TclListObjIsCanonical(listPtr) \ (((listPtr)->typePtr == &tclListType) ? ListObjIsCanonical((listPtr)) : 0) /* * Macros providing a faster path to integers: Tcl_GetLongFromObj everywhere, * Tcl_GetIntFromObj and TclGetIntForIndex on platforms where longs are ints. * * WARNING: these macros eval their args more than once. */ |
︙ | ︙ | |||
2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 | MODULE_SCOPE int TclSubstOptions(Tcl_Interp *interp, int numOpts, Tcl_Obj *const opts[], int *flagPtr); MODULE_SCOPE void TclSubstParse(Tcl_Interp *interp, const char *bytes, int numBytes, int flags, Tcl_Parse *parsePtr, Tcl_InterpState *statePtr); MODULE_SCOPE int TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count, int *tokensLeftPtr); MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(ClientData clientData); MODULE_SCOPE Tcl_Obj * TclpFilesystemPathType(Tcl_Obj *pathPtr); MODULE_SCOPE int TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr); MODULE_SCOPE int TclpUtime(Tcl_Obj *pathPtr, struct utimbuf *tval); #ifdef TCL_LOAD_FROM_MEMORY | > > > > | 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 | MODULE_SCOPE int TclSubstOptions(Tcl_Interp *interp, int numOpts, Tcl_Obj *const opts[], int *flagPtr); MODULE_SCOPE void TclSubstParse(Tcl_Interp *interp, const char *bytes, int numBytes, int flags, Tcl_Parse *parsePtr, Tcl_InterpState *statePtr); MODULE_SCOPE int TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count, int *tokensLeftPtr); MODULE_SCOPE int TclTrimLeft(const char *bytes, int numBytes, const char *trim, int numTrim); MODULE_SCOPE int TclTrimRight(const char *bytes, int numBytes, const char *trim, int numTrim); MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(ClientData clientData); MODULE_SCOPE Tcl_Obj * TclpFilesystemPathType(Tcl_Obj *pathPtr); MODULE_SCOPE int TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr); MODULE_SCOPE int TclpUtime(Tcl_Obj *pathPtr, struct utimbuf *tval); #ifdef TCL_LOAD_FROM_MEMORY |
︙ | ︙ |
Changes to generic/tclListObj.c.
︙ | ︙ | |||
442 443 444 445 446 447 448 | } result = SetListFromAny(interp, listPtr); if (result != TCL_OK) { return result; } } | | | 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 | } result = SetListFromAny(interp, listPtr); if (result != TCL_OK) { return result; } } listRepPtr = ListRepPtr(listPtr); *objcPtr = listRepPtr->elemCount; *objvPtr = &listRepPtr->elements; return TCL_OK; } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
560 561 562 563 564 565 566 | result = SetListFromAny(interp, listPtr); if (result != TCL_OK) { return result; } } | | | 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 | result = SetListFromAny(interp, listPtr); if (result != TCL_OK) { return result; } } listRepPtr = ListRepPtr(listPtr); numElems = listRepPtr->elemCount; numRequired = numElems + 1 ; /* * If there is no room in the current array of element pointers, allocate * a new, larger array and copy the pointers to it. If the List struct is * shared, allocate a new one. |
︙ | ︙ | |||
670 671 672 673 674 675 676 | result = SetListFromAny(interp, listPtr); if (result != TCL_OK) { return result; } } | | | 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 | result = SetListFromAny(interp, listPtr); if (result != TCL_OK) { return result; } } listRepPtr = ListRepPtr(listPtr); if ((index < 0) || (index >= listRepPtr->elemCount)) { *objPtrPtr = NULL; } else { *objPtrPtr = (&listRepPtr->elements)[index]; } return TCL_OK; |
︙ | ︙ | |||
725 726 727 728 729 730 731 | result = SetListFromAny(interp, listPtr); if (result != TCL_OK) { return result; } } | | | 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 | result = SetListFromAny(interp, listPtr); if (result != TCL_OK) { return result; } } listRepPtr = ListRepPtr(listPtr); *intPtr = listRepPtr->elemCount; return TCL_OK; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
812 813 814 815 816 817 818 | * Note that when count == 0 and objc == 0, this routine is logically a * no-op, removing and adding no elements to the list. However, by flowing * through this routine anyway, we get the important side effect that the * resulting listPtr is a list in canoncial form. This is important. * Resist any temptation to optimize this case. */ | | | 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 | * Note that when count == 0 and objc == 0, this routine is logically a * no-op, removing and adding no elements to the list. However, by flowing * through this routine anyway, we get the important side effect that the * resulting listPtr is a list in canoncial form. This is important. * Resist any temptation to optimize this case. */ listRepPtr = ListRepPtr(listPtr); elemPtrs = &listRepPtr->elements; numElems = listRepPtr->elemCount; if (first < 0) { first = 0; } if (first >= numElems) { |
︙ | ︙ | |||
1519 1520 1521 1522 1523 1524 1525 | } result = SetListFromAny(interp, listPtr); if (result != TCL_OK) { return result; } } | | | 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 | } result = SetListFromAny(interp, listPtr); if (result != TCL_OK) { return result; } } listRepPtr = ListRepPtr(listPtr); elemCount = listRepPtr->elemCount; elemPtrs = &listRepPtr->elements; /* * Ensure that the index is in bounds. */ |
︙ | ︙ | |||
1606 1607 1608 1609 1610 1611 1612 | *---------------------------------------------------------------------- */ static void FreeListInternalRep( Tcl_Obj *listPtr) /* List object with internal rep to free. */ { | | | 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 | *---------------------------------------------------------------------- */ static void FreeListInternalRep( Tcl_Obj *listPtr) /* List object with internal rep to free. */ { register List *listRepPtr = ListRepPtr(listPtr); register Tcl_Obj **elemPtrs = &listRepPtr->elements; register Tcl_Obj *objPtr; int numElems = listRepPtr->elemCount; int i; if (--listRepPtr->refCount <= 0) { for (i = 0; i < numElems; i++) { |
︙ | ︙ | |||
1647 1648 1649 1650 1651 1652 1653 | */ static void DupListInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { | | | 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 | */ static void DupListInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { List *listRepPtr = ListRepPtr(srcPtr); listRepPtr->refCount++; copyPtr->internalRep.twoPtrValue.ptr1 = listRepPtr; copyPtr->internalRep.twoPtrValue.ptr2 = NULL; copyPtr->typePtr = &tclListType; } |
︙ | ︙ | |||
1869 1870 1871 1872 1873 1874 1875 | static void UpdateStringOfList( Tcl_Obj *listPtr) /* List object with string rep to update. */ { # define LOCAL_SIZE 20 int localFlags[LOCAL_SIZE], *flagPtr; | | | 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 | static void UpdateStringOfList( Tcl_Obj *listPtr) /* List object with string rep to update. */ { # define LOCAL_SIZE 20 int localFlags[LOCAL_SIZE], *flagPtr; List *listRepPtr = ListRepPtr(listPtr); int numElems = listRepPtr->elemCount; register int i; const char *elem; char *dst; int length; Tcl_Obj **elemPtrs; |
︙ | ︙ |
Changes to generic/tclUtil.c.
︙ | ︙ | |||
941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 | TclUtfToUniChar(buf, &ch); return (char) ch; } /* *---------------------------------------------------------------------- * * Tcl_Concat -- * * Concatenate a set of strings into a single large string. * * Results: * The return value is dynamically-allocated string containing a * concatenation of all the strings in argv, with spaces between the * original argv elements. * * Side effects: * Memory is allocated for the result; the caller is responsible for * freeing the memory. * *---------------------------------------------------------------------- */ char * Tcl_Concat( int argc, /* Number of strings to concatenate. */ const char *const *argv) /* Array of strings to concatenate. */ { | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | < | < < < | > | | < > > | > > | > > < < > > > | > > > > > > > > | > > | > | > > > > | < | | | < | > | | < > > | < | < < > | | > | 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 | TclUtfToUniChar(buf, &ch); return (char) ch; } /* *---------------------------------------------------------------------- * * TclTrimRight -- * Takes two counted strings in the Tcl encoding which must both be * null terminated. Conceptually trims from the right side of the * first string all characters found in the second string. * * Results: * The number of bytes to be removed from the end of the string. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclTrimRight( const char *bytes, /* String to be trimmed... */ int numBytes, /* ...and its length in bytes */ const char *trim, /* String of trim characters... */ int numTrim) /* ...and its length in bytes */ { const char *p = bytes + numBytes; int pInc; if ((bytes[numBytes] != '\0') || (trim[numTrim] != '\0')) { Tcl_Panic("TclTrimRight works only on null-terminated strings"); } /* Empty strings -> nothing to do */ if ((numBytes == 0) || (numTrim == 0)) { return 0; } /* Outer loop: iterate over string to be trimmed */ do { Tcl_UniChar ch1; const char *q = trim; int bytesLeft = numTrim; p = Tcl_UtfPrev(p, bytes); pInc = TclUtfToUniChar(p, &ch1); /* Inner loop: scan trim string for match to current character */ do { Tcl_UniChar ch2; int qInc = TclUtfToUniChar(q, &ch2); if (ch1 == ch2) { break; } q += qInc; bytesLeft -= qInc; } while (bytesLeft); if (bytesLeft == 0) { /* No match; trim task done; *p is last non-trimmed char */ p += pInc; break; } } while (p > bytes); return numBytes - (p - bytes); } /* *---------------------------------------------------------------------- * * TclTrimLeft -- * Takes two counted strings in the Tcl encoding which must both be * null terminated. Conceptually trims from the left side of the * first string all characters found in the second string. * * Results: * The number of bytes to be removed from the start of the string. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclTrimLeft( const char *bytes, /* String to be trimmed... */ int numBytes, /* ...and its length in bytes */ const char *trim, /* String of trim characters... */ int numTrim) /* ...and its length in bytes */ { const char *p = bytes; if ((bytes[numBytes] != '\0') || (trim[numTrim] != '\0')) { Tcl_Panic("TclTrimLeft works only on null-terminated strings"); } /* Empty strings -> nothing to do */ if ((numBytes == 0) || (numTrim == 0)) { return 0; } /* Outer loop: iterate over string to be trimmed */ do { Tcl_UniChar ch1; int pInc = TclUtfToUniChar(p, &ch1); const char *q = trim; int bytesLeft = numTrim; /* Inner loop: scan trim string for match to current character */ do { Tcl_UniChar ch2; int qInc = TclUtfToUniChar(q, &ch2); if (ch1 == ch2) { break; } q += qInc; bytesLeft -= qInc; } while (bytesLeft); if (bytesLeft == 0) { /* No match; trim task done; *p is first non-trimmed char */ break; } p += pInc; numBytes -= pInc; } while (numBytes); return p - bytes; } /* *---------------------------------------------------------------------- * * Tcl_Concat -- * * Concatenate a set of strings into a single large string. * * Results: * The return value is dynamically-allocated string containing a * concatenation of all the strings in argv, with spaces between the * original argv elements. * * Side effects: * Memory is allocated for the result; the caller is responsible for * freeing the memory. * *---------------------------------------------------------------------- */ /* The whitespace characters trimmed during [concat] operations */ #define CONCAT_WS " \f\v\r\t\n" #define CONCAT_WS_SIZE (int) (sizeof(CONCAT_WS "") - 1) char * Tcl_Concat( int argc, /* Number of strings to concatenate. */ const char *const *argv) /* Array of strings to concatenate. */ { int i, needSpace = 0, bytesNeeded = 0; char *result, *p; /* Dispose of the empty result corner case first to simplify later code */ if (argc == 0) { result = (char *) ckalloc(1); result[0] = '\0'; return result; } /* First allocate the result buffer at the size required */ for (i = 0; i < argc; i++) { bytesNeeded += strlen(argv[i]); if (bytesNeeded < 0) { Tcl_Panic("Tcl_Concat: max size of Tcl value exceeded"); } } if (bytesNeeded + argc - 1 < 0) { /* * Panic test could be tighter, but not going to bother for * this legacy routine. */ Tcl_Panic("Tcl_Concat: max size of Tcl value exceeded"); } /* All element bytes + (argc - 1) spaces + 1 terminating NULL */ result = (char *) ckalloc((unsigned) (bytesNeeded + argc)); for (p = result, i = 0; i < argc; i++) { int trim, elemLength; const char *element; element = argv[i]; elemLength = strlen(argv[i]); /* Trim away the leading whitespace */ trim = TclTrimLeft(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE); element += trim; elemLength -= trim; /* * Trim away the trailing whitespace. Do not permit trimming * to expose a final backslash character. */ trim = TclTrimRight(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE); trim -= trim && (element[elemLength - trim - 1] == '\\'); elemLength -= trim; /* If we're left with empty element after trimming, do nothing */ if (elemLength == 0) { continue; } /* Append to the result with space if needed */ if (needSpace) { *p++ = ' '; } memcpy(p, element, (size_t) elemLength); p += elemLength; needSpace = 1; } *p = '\0'; return result; } /* *---------------------------------------------------------------------- * * Tcl_ConcatObj -- |
︙ | ︙ | |||
1033 1034 1035 1036 1037 1038 1039 | */ Tcl_Obj * Tcl_ConcatObj( int objc, /* Number of objects to concatenate. */ Tcl_Obj *const objv[]) /* Array of objects to concatenate. */ { | | < < | < < < | | < < < < | | < < | > | | 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 | */ Tcl_Obj * Tcl_ConcatObj( int objc, /* Number of objects to concatenate. */ Tcl_Obj *const objv[]) /* Array of objects to concatenate. */ { int i, elemLength, needSpace = 0, bytesNeeded = 0; const char *element; Tcl_Obj *objPtr, *resPtr; /* * Check first to see if all the items are of list type or empty. If so, * we will concat them together as lists, and return a list object. This * is only valid when the lists are in canonical form. */ for (i = 0; i < objc; i++) { int length; objPtr = objv[i]; if (TclListObjIsCanonical(objPtr)) { continue; } Tcl_GetStringFromObj(objPtr, &length); if (length > 0) { break; } } if (i == objc) { Tcl_Obj **listv; int listc; resPtr = NULL; for (i = 0; i < objc; i++) { /* * Tcl_ListObjAppendList could be used here, but this saves us a * bit of type checking (since we've already done it). Use of * INT_MAX tells us to always put the new stuff on the end. It * will be set right in Tcl_ListObjReplace. * Note that all objs at this point are either lists or have an * empty string rep. */ objPtr = objv[i]; if (objPtr->bytes && objPtr->length == 0) { continue; } TclListObjGetElements(NULL, objPtr, &listc, &listv); if (listc) { if (resPtr) { Tcl_ListObjReplace(NULL, resPtr, INT_MAX, 0, listc, listv); } else { |
︙ | ︙ | |||
1104 1105 1106 1107 1108 1109 1110 | } /* * Something cannot be determined to be safe, so build the concatenation * the slow way, using the string representations. */ | | < | < | < < | < > | | < < > | > | < | < < < < < > < < < < < | > | | | | > | | | < | | | < | | | < < | | > | | | < < < < < | > | < < < < > > > < < < < | | 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 | } /* * Something cannot be determined to be safe, so build the concatenation * the slow way, using the string representations. */ /* First try to pre-allocate the size required */ for (i = 0; i < objc; i++) { element = TclGetStringFromObj(objv[i], &elemLength); bytesNeeded += elemLength; if (bytesNeeded < 0) { break; } } /* * Does not matter if this fails, will simply try later to build up * the string with each Append reallocating as needed with the usual * string append algorithm. When that fails it will report the error. */ TclNewObj(resPtr); Tcl_AttemptSetObjLength(resPtr, bytesNeeded + objc - 1); Tcl_SetObjLength(resPtr, 0); for (i = 0; i < objc; i++) { int trim; element = TclGetStringFromObj(objv[i], &elemLength); /* Trim away the leading whitespace */ trim = TclTrimLeft(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE); element += trim; elemLength -= trim; /* * Trim away the trailing whitespace. Do not permit trimming * to expose a final backslash character. */ trim = TclTrimRight(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE); trim -= trim && (element[elemLength - trim - 1] == '\\'); elemLength -= trim; /* If we're left with empty element after trimming, do nothing */ if (elemLength == 0) { continue; } /* Append to the result with space if needed */ if (needSpace) { Tcl_AppendToObj(resPtr, " ", 1); } Tcl_AppendToObj(resPtr, element, elemLength); needSpace = 1; } return resPtr; } /* *---------------------------------------------------------------------- * * Tcl_StringMatch -- * |
︙ | ︙ |
Changes to generic/tclVar.c.
︙ | ︙ | |||
2663 2664 2665 2666 2667 2668 2669 | if (varPtr == NULL) { return TCL_ERROR; } for (i=2 ; i<objc ; i++) { /* * Note that we do not need to increase the refCount of the Var * pointers: should a trace delete the variable, the return value | | | | > | 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 | if (varPtr == NULL) { return TCL_ERROR; } for (i=2 ; i<objc ; i++) { /* * Note that we do not need to increase the refCount of the Var * pointers: should a trace delete the variable, the return value * of TclPtrSetVar will be NULL or emptyObjPtr, and we will not * access the variable again. */ varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, objv[1], NULL, objv[i], TCL_APPEND_VALUE|TCL_LEAVE_ERR_MSG, -1); if ((varValuePtr == NULL) || (varValuePtr == ((Interp *) interp)->emptyObjPtr)) { return TCL_ERROR; } } } Tcl_SetObjResult(interp, varValuePtr); return TCL_OK; } |
︙ | ︙ |
Changes to library/tzdata/Atlantic/Stanley.
︙ | ︙ | |||
68 69 70 71 72 73 74 | {1188712800 -10800 1 FKST} {1208667600 -14400 0 FKT} {1220767200 -10800 1 FKST} {1240117200 -14400 0 FKT} {1252216800 -10800 1 FKST} {1271566800 -14400 0 FKT} {1283666400 -10800 1 FKST} | < | | 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 | {1188712800 -10800 1 FKST} {1208667600 -14400 0 FKT} {1220767200 -10800 1 FKST} {1240117200 -14400 0 FKT} {1252216800 -10800 1 FKST} {1271566800 -14400 0 FKT} {1283666400 -10800 1 FKST} {1315112400 -10800 1 FKST} {1334466000 -14400 0 FKT} {1346565600 -10800 1 FKST} {1366520400 -14400 0 FKT} {1378015200 -10800 1 FKST} {1397970000 -14400 0 FKT} {1410069600 -10800 1 FKST} {1429419600 -14400 0 FKT} |
︙ | ︙ |
Changes to tests/load.test.
︙ | ︙ | |||
78 79 80 81 82 83 84 | list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg $errorCode } -match glob \ -result [list 1 {cannot find symbol "Foo_Init"*} \ {TCL LOOKUP LOAD_SYMBOL *Foo_Init}] test load-2.4 {loading with no _SafeInit procedure} [list $dll $loaded] { list [catch {load [file join $testDir pkga$ext] {} child} msg] $msg } {1 {can't use package in a safe interpreter: no Pkga_SafeInit procedure}} | < < < < | 78 79 80 81 82 83 84 85 86 87 88 89 90 91 | list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg $errorCode } -match glob \ -result [list 1 {cannot find symbol "Foo_Init"*} \ {TCL LOOKUP LOAD_SYMBOL *Foo_Init}] test load-2.4 {loading with no _SafeInit procedure} [list $dll $loaded] { list [catch {load [file join $testDir pkga$ext] {} child} msg] $msg } {1 {can't use package in a safe interpreter: no Pkga_SafeInit procedure}} test load-3.1 {error in _Init procedure, same interpreter} \ [list $dll $loaded] { list [catch {load [file join $testDir pkge$ext] pkge} msg] \ $msg $::errorInfo $::errorCode } {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory while executing |
︙ | ︙ |
Changes to tests/string.test.
︙ | ︙ | |||
1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 | string reverse $x } \udead\ubeef test string-24.11 {string reverse command - corner case} { set x \ubeef set y \udead string reverse $x$y } \udead\ubeef test string-25.1 {string is list} { string is list {a b c} } 1 test string-25.2 {string is list} { string is list "a \{b c" } 0 | > > > > > | 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 | string reverse $x } \udead\ubeef test string-24.11 {string reverse command - corner case} { set x \ubeef set y \udead string reverse $x$y } \udead\ubeef test string-24.12 {string reverse command - corner case} { set x \ubeef set y \udead string is ascii [string reverse $x$y] } 0 test string-25.1 {string is list} { string is list {a b c} } 1 test string-25.2 {string is list} { string is list "a \{b c" } 0 |
︙ | ︙ |
Changes to unix/dltest/pkga.c.
︙ | ︙ | |||
25 26 27 28 29 30 31 | * Prototypes for procedures defined later in this file: */ static int Pkga_EqObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int Pkga_QuoteObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); | < < < < < < < < < < < | 25 26 27 28 29 30 31 32 33 34 35 36 37 38 | * Prototypes for procedures defined later in this file: */ static int Pkga_EqObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int Pkga_QuoteObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* *---------------------------------------------------------------------- * * Pkga_EqObjCmd -- * * This procedure is invoked to process the "pkga_eq" Tcl command. It |
︙ | ︙ | |||
106 107 108 109 110 111 112 | static int Pkga_QuoteObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings. */ { | | < < < < | 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 | static int Pkga_QuoteObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings. */ { if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "value"); return TCL_ERROR; } Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } /* *---------------------------------------------------------------------- * * Pkga_Init -- |
︙ | ︙ |
Changes to unix/dltest/pkgua.c.
︙ | ︙ | |||
9 10 11 12 13 14 15 | * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #undef STATIC_BUILD #include "tcl.h" | < | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #undef STATIC_BUILD #include "tcl.h" /* * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the * Pkgua_Init declaration is in the source file itself, which is only * accessed when we are building a library. */ #undef TCL_STORAGE_CLASS |
︙ | ︙ | |||
172 173 174 175 176 177 178 | static int PkguaQuoteObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings. */ { | | < < < < < < < < < < | 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 | static int PkguaQuoteObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings. */ { if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "value"); return TCL_ERROR; } Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } /* *---------------------------------------------------------------------- * * Pkgua_Init -- |
︙ | ︙ |
Changes to unix/tcl.m4.
︙ | ︙ | |||
116 117 118 119 120 121 122 | fi done fi ]) if test x"${ac_cv_c_tclconfig}" = x ; then TCL_BIN_DIR="# no Tcl configs found" | | < | 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 | fi done fi ]) if test x"${ac_cv_c_tclconfig}" = x ; then TCL_BIN_DIR="# no Tcl configs found" AC_MSG_ERROR([Can't find Tcl configuration definitions. Use --with-tcl to specify a directory containing tclConfig.sh]) else no_tcl= TCL_BIN_DIR="${ac_cv_c_tclconfig}" AC_MSG_RESULT([found ${TCL_BIN_DIR}/tclConfig.sh]) fi fi ]) |
︙ | ︙ | |||
247 248 249 250 251 252 253 | fi done fi ]) if test x"${ac_cv_c_tkconfig}" = x ; then TK_BIN_DIR="# no Tk configs found" | | < | 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 | fi done fi ]) if test x"${ac_cv_c_tkconfig}" = x ; then TK_BIN_DIR="# no Tk configs found" AC_MSG_ERROR([Can't find Tk configuration definitions. Use --with-tk to specify a directory containing tkConfig.sh]) else no_tk= TK_BIN_DIR="${ac_cv_c_tkconfig}" AC_MSG_RESULT([found ${TK_BIN_DIR}/tkConfig.sh]) fi fi ]) |
︙ | ︙ | |||
303 304 305 306 307 308 309 | if test -f "${TCL_BIN_DIR}/Makefile" ; then TCL_LIB_SPEC="${TCL_BUILD_LIB_SPEC}" TCL_STUB_LIB_SPEC="${TCL_BUILD_STUB_LIB_SPEC}" TCL_STUB_LIB_PATH="${TCL_BUILD_STUB_LIB_PATH}" elif test "`uname -s`" = "Darwin"; then # If Tcl was built as a framework, attempt to use the libraries # from the framework at the given location so that linking works | | | 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 | if test -f "${TCL_BIN_DIR}/Makefile" ; then TCL_LIB_SPEC="${TCL_BUILD_LIB_SPEC}" TCL_STUB_LIB_SPEC="${TCL_BUILD_STUB_LIB_SPEC}" TCL_STUB_LIB_PATH="${TCL_BUILD_STUB_LIB_PATH}" elif test "`uname -s`" = "Darwin"; then # If Tcl was built as a framework, attempt to use the libraries # from the framework at the given location so that linking works # against Tcl.framework installed in an arbitrary location. case ${TCL_DEFS} in *TCL_FRAMEWORK*) if test -f "${TCL_BIN_DIR}/${TCL_LIB_FILE}"; then for i in "`cd "${TCL_BIN_DIR}"; pwd`" \ "`cd "${TCL_BIN_DIR}"/../..; pwd`"; do if test "`basename "$i"`" = "${TCL_LIB_FILE}.framework"; then TCL_LIB_SPEC="-F`dirname "$i" | sed -e 's/ /\\\\ /g'` -framework ${TCL_LIB_FILE}" |
︙ | ︙ | |||
386 387 388 389 390 391 392 | if test -f "${TK_BIN_DIR}/Makefile" ; then TK_LIB_SPEC="${TK_BUILD_LIB_SPEC}" TK_STUB_LIB_SPEC="${TK_BUILD_STUB_LIB_SPEC}" TK_STUB_LIB_PATH="${TK_BUILD_STUB_LIB_PATH}" elif test "`uname -s`" = "Darwin"; then # If Tk was built as a framework, attempt to use the libraries # from the framework at the given location so that linking works | | | 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 | if test -f "${TK_BIN_DIR}/Makefile" ; then TK_LIB_SPEC="${TK_BUILD_LIB_SPEC}" TK_STUB_LIB_SPEC="${TK_BUILD_STUB_LIB_SPEC}" TK_STUB_LIB_PATH="${TK_BUILD_STUB_LIB_PATH}" elif test "`uname -s`" = "Darwin"; then # If Tk was built as a framework, attempt to use the libraries # from the framework at the given location so that linking works # against Tk.framework installed in an arbitrary location. case ${TK_DEFS} in *TK_FRAMEWORK*) if test -f "${TK_BIN_DIR}/${TK_LIB_FILE}"; then for i in "`cd "${TK_BIN_DIR}"; pwd`" \ "`cd "${TK_BIN_DIR}"/../..; pwd`"; do if test "`basename "$i"`" = "${TK_LIB_FILE}.framework"; then TK_LIB_SPEC="-F`dirname "$i" | sed -e 's/ /\\\\ /g'` -framework ${TK_LIB_FILE}" |
︙ | ︙ | |||
2367 2368 2369 2370 2371 2372 2373 | # no include files, so double-check its result just to be safe. # # Arguments: # none # # Results: # | | | 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 | # no include files, so double-check its result just to be safe. # # Arguments: # none # # Results: # # Sets the following vars: # XINCLUDES # XLIBSW # #-------------------------------------------------------------------- AC_DEFUN([SC_PATH_X], [ AC_PATH_X |
︙ | ︙ |
Changes to unix/tclAppInit.c.
︙ | ︙ | |||
150 151 152 153 154 155 156 | (Tcl_SetVar)(interp, "tcl_rcFileName", "~/tclsh.rc", TCL_GLOBAL_ONLY); #else (Tcl_SetVar)(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY); #endif return TCL_OK; } | < < < < < < < < | 150 151 152 153 154 155 156 157 158 159 160 161 162 163 | (Tcl_SetVar)(interp, "tcl_rcFileName", "~/tclsh.rc", TCL_GLOBAL_ONLY); #else (Tcl_SetVar)(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY); #endif return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: |
︙ | ︙ |