Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch strict-index-experiment Through [c3bd1d3004] Excluding Merge-Ins
This is equivalent to a diff from f0bd4b3d9c to c3bd1d3004
|
2020-03-31
| ||
| 14:19 | Merge jn-index-reform check-in: 16f8ccae83 user: jan.nijtmans tags: strict-index-experiment | |
|
2020-03-30
| ||
| 15:51 | Merge 8.6; revise to use TclGetBytesFromObj. check-in: a9eed52a58 user: dgp tags: core-8-branch | |
| 15:31 | Merge jn-index-reform check-in: c3bd1d3004 user: jan.nijtmans tags: strict-index-experiment | |
| 15:30 | Merge 8.7 check-in: bff8682dc2 user: jan.nijtmans tags: jn-index-reform | |
| 15:27 | Initialize Tcl_UniChar's, in case we are handling surrogates (however unlikely). check-in: f0bd4b3d9c user: jan.nijtmans tags: core-8-branch | |
| 15:13 | Merge 8.6, revise to use TclGetBytesFromObj. check-in: 3f0a218557 user: dgp tags: core-8-branch | |
| 13:09 | Merge jn-index-reform check-in: 2c684cf313 user: jan.nijtmans tags: strict-index-experiment | |
Changes to generic/tcl.decls.
| ︙ | |||
2382 2383 2384 2385 2386 2387 2388 | 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 | - + |
declare 644 {
int Tcl_LinkArray(Tcl_Interp *interp, const char *varName, void *addr,
int type, int size)
}
declare 645 {
int Tcl_GetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
|
| ︙ |
Changes to generic/tcl.h.
| ︙ | |||
554 555 556 557 558 559 560 561 562 563 564 565 566 567 | 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 | + + + + + + + + |
/*
* Flags values passed to Tcl_RegExpExecObj.
*/
#define TCL_REG_NOTBOL 0001 /* Beginning of string does not match ^. */
#define TCL_REG_NOTEOL 0002 /* End of string does not match $. */
/*
* Flags values passed to Tcl_GetIntForIndex().
*/
#define TCL_INDEX_ERROR 0x100 /* Generate "out of range" errors when index < 0 */
#define TCL_INDEX_NOMIN 0x200 /* Convert values < 0 to 0 (or generate error for this) */
#define TCL_INDEX_NOMAX 0x400 /* Convert values > end to end (or generate error for this) */
/*
* Structures filled in by Tcl_RegExpInfo. Note that all offset values are
* relative to the start of the match string, not the beginning of the entire
* string.
*/
typedef struct Tcl_RegExpIndices {
|
| ︙ |
Changes to generic/tclAssembly.c.
| ︙ | |||
501 502 503 504 505 506 507 508 509 510 511 512 513 514 | 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 | + |
{"unsetArrayStk", ASSEM_BOOL, INST_UNSET_ARRAY_STK, 2, 0},
{"unsetStk", ASSEM_BOOL, INST_UNSET_STK, 1, 0},
{"uplus", ASSEM_1BYTE, INST_UPLUS, 1, 1},
{"upvar", ASSEM_LVT4, INST_UPVAR, 2, 1},
{"variable", ASSEM_LVT4, INST_VARIABLE, 1, 0},
{"verifyDict", ASSEM_1BYTE, INST_DICT_VERIFY, 1, 0},
{"yield", ASSEM_1BYTE, INST_YIELD, 1, 1},
{"tryCvtToIndex", ASSEM_1BYTE, INST_TRY_CVT_TO_INDEX,1, 2},
{NULL, ASSEM_1BYTE, 0, 0, 0}
};
/*
* List of instructions that cannot throw an exception under any
* circumstances. These instructions are the ones that are permissible after
* an exception is caught but before the corresponding exception range is
|
| ︙ |
Changes to generic/tclCmdIL.c.
| ︙ | |||
2412 2413 2414 2415 2416 2417 2418 | 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 | - + |
/*
* Get the index. "end" is interpreted to be the index after the last
* element, such that using it will cause any inserted elements to be
* appended to the list.
*/
|
| ︙ | |||
2672 2673 2674 2675 2676 2677 2678 | 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 | - + - + |
result = TclListObjLength(interp, objv[1], &listLen);
if (result != TCL_OK) {
return result;
}
result = TclGetIntForIndexM(interp, objv[2], /*endValue*/ listLen - 1,
|
| ︙ | |||
2752 2753 2754 2755 2756 2757 2758 | 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 | - + |
if (idxc == 0) {
Tcl_SetObjResult(interp, listObj);
return TCL_OK;
}
idxv = (int *)ckalloc((objc - 2) * sizeof(int));
for (i = 2; i < objc; i++) {
if (TclGetIntForIndexM(interp, objv[i], /*endValue*/ listLen - 1,
|
| ︙ | |||
2974 2975 2976 2977 2978 2979 2980 | 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 | - + - + |
/*
* Get the first and last indexes. "end" is interpreted to be the index
* for the last element, such that using it will cause that element to be
* included for deletion.
*/
|
| ︙ | |||
3492 3493 3494 3495 3496 3497 3498 | 3492 3493 3494 3495 3496 3497 3498 3499 3500 3501 3502 3503 3504 3505 3506 | - + |
}
/*
* Get the user-specified start offset.
*/
if (startPtr) {
|
| ︙ |
Changes to generic/tclCmdMZ.c.
| ︙ | |||
191 192 193 194 195 196 197 | 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 | - + |
cflags |= TCL_REG_NLANCH;
break;
case REGEXP_START: {
int temp;
if (++i >= objc) {
goto endOfForLoop;
}
|
| ︙ | |||
255 256 257 258 259 260 261 | 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 | - + |
* regexp to avoid shimmering problems.
*/
objPtr = objv[1];
stringLength = Tcl_GetCharLength(objPtr);
if (startIndex) {
|
| ︙ | |||
546 547 548 549 550 551 552 | 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 | - + |
cflags |= TCL_REG_NLANCH;
break;
case REGSUB_START: {
int temp;
if (++idx >= objc) {
goto endOfForLoop;
}
|
| ︙ | |||
579 580 581 582 583 584 585 | 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 | - + |
objc -= idx;
objv += idx;
if (startIndex) {
int stringLength = Tcl_GetCharLength(objv[1]);
|
| ︙ | |||
1329 1330 1331 1332 1333 1334 1335 | 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 | - + |
"needleString haystackString ?startIndex?");
return TCL_ERROR;
}
if (objc == 4) {
int size = Tcl_GetCharLength(objv[2]);
|
| ︙ | |||
1373 1374 1375 1376 1377 1378 1379 | 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 | - + |
"needleString haystackString ?lastIndex?");
return TCL_ERROR;
}
if (objc == 4) {
int size = Tcl_GetCharLength(objv[2]);
|
| ︙ | |||
1418 1419 1420 1421 1422 1423 1424 | 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 | - + |
}
/*
* Get the char length to calculate what 'end' means.
*/
length = Tcl_GetCharLength(objv[1]);
|
| ︙ | |||
1486 1487 1488 1489 1490 1491 1492 | 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 | - + |
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv, "string index insertString");
return TCL_ERROR;
}
length = Tcl_GetCharLength(objv[1]);
|
| ︙ | |||
1543 1544 1545 1546 1547 1548 1549 | 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 | - - - - + + + + - - - - + + + + |
int i, failat = 0, result = 1, strict = 0, index, length1, length2;
Tcl_Obj *objPtr, *failVarObj = NULL;
Tcl_WideInt w;
static const char *const isClasses[] = {
"alnum", "alpha", "ascii", "control",
"boolean", "dict", "digit", "double",
|
| ︙ | |||
1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 | 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 | + + + + + + + + + + |
/*
* No prefix is a valid integer. Fail at beginning.
*/
result = 0;
failat = 0;
}
break;
case STR_IS_INDEX:
case STR_IS_NONE:
if (TCL_OK == TclGetWideForIndex(NULL, objPtr, (unsigned)-2, 0, &w)) {
if ((w < -1) || (w > (unsigned)-1) || ((STR_IS_NONE == (enum isClasses) index) && (w != -1))) {
result = 0;
}
} else {
result = 0;
}
break;
case STR_IS_WIDE:
if (TCL_OK == TclGetWideIntFromObj(NULL, objPtr, &w)) {
break;
}
string1 = TclGetStringFromObj(objPtr, &length1);
|
| ︙ | |||
2309 2310 2311 2312 2313 2314 2315 | 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 | - - + + |
/*
* Get the length in actual characters; Then reduce it by one because
* 'end' refers to the last character, not one past it.
*/
length = Tcl_GetCharLength(objv[1]) - 1;
|
| ︙ | |||
2417 2418 2419 2420 2421 2422 2423 | 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 | - - + + |
Tcl_WrongNumArgs(interp, 1, objv, "string first last ?string?");
return TCL_ERROR;
}
length = Tcl_GetCharLength(objv[1]);
end = length - 1;
|
| ︙ | |||
2529 2530 2531 2532 2533 2534 2535 | 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 | - + |
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "string index");
return TCL_ERROR;
}
string = TclGetStringFromObj(objv[1], &length);
numChars = Tcl_NumUtfChars(string, length);
|
| ︙ | |||
2590 2591 2592 2593 2594 2595 2596 | 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 | - + |
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "string index");
return TCL_ERROR;
}
string = TclGetStringFromObj(objv[1], &length);
numChars = Tcl_NumUtfChars(string, length);
|
| ︙ | |||
2943 2944 2945 2946 2947 2948 2949 | 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 | - + - + |
Tcl_SetObjResult(interp, resultPtr);
} else {
int first, last;
const char *start, *end;
Tcl_Obj *resultPtr;
length1 = Tcl_NumUtfChars(string1, length1) - 1;
|
| ︙ | |||
3028 3029 3030 3031 3032 3033 3034 | 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 | - + - + |
Tcl_SetObjResult(interp, resultPtr);
} else {
int first, last;
const char *start, *end;
Tcl_Obj *resultPtr;
length1 = Tcl_NumUtfChars(string1, length1) - 1;
|
| ︙ | |||
3113 3114 3115 3116 3117 3118 3119 | 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 | - + - + |
Tcl_SetObjResult(interp, resultPtr);
} else {
int first, last;
const char *start, *end;
Tcl_Obj *resultPtr;
length1 = Tcl_NumUtfChars(string1, length1) - 1;
|
| ︙ |
Changes to generic/tclCompCmdsSZ.c.
| ︙ | |||
502 503 504 505 506 507 508 | 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 | - - + + - - + + |
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
static const char *const isClasses[] = {
"alnum", "alpha", "ascii", "control",
"boolean", "dict", "digit", "double", "entier",
|
| ︙ | |||
707 708 709 710 711 712 713 714 715 716 717 718 719 720 | 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 | + + + + + |
FIXJUMP1( satisfied);
}
PUSH( "1");
FIXJUMP1( end);
return TCL_OK;
}
case STR_IS_INDEX:
case STR_IS_NONE:
/* Not implemented yet */
return TCL_ERROR;
break;
case STR_IS_INT:
case STR_IS_WIDE:
case STR_IS_ENTIER:
if (allowEmpty) {
int testNumType;
OP( DUP);
|
| ︙ |
Changes to generic/tclCompile.h.
| ︙ | |||
844 845 846 847 848 849 850 851 852 853 854 855 856 857 | 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 | + + + | /* TIP 461 */ #define INST_STR_LT 191 #define INST_STR_GT 192 #define INST_STR_LE 193 #define INST_STR_GE 194 /* TIP ??? */ #define INST_TRY_CVT_TO_INDEX 195 /* The last opcode */ #define LAST_INST_OPCODE 194 /* * Table describing the Tcl bytecode instructions: their name (for displaying * code), total number of code bytes required (including operand bytes), and a * description of the type of each operand. These operand types include signed |
| ︙ |
Changes to generic/tclDecls.h.
| ︙ | |||
1908 1909 1910 1911 1912 1913 1914 | 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 | - + + | EXTERN int Tcl_IsShared(Tcl_Obj *objPtr); /* 644 */ EXTERN int Tcl_LinkArray(Tcl_Interp *interp, const char *varName, void *addr, int type, int size); /* 645 */ EXTERN int Tcl_GetIntForIndex(Tcl_Interp *interp, |
| ︙ | |||
2597 2598 2599 2600 2601 2602 2603 | 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 | - + |
Tcl_ObjIntRep * (*tcl_FetchIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 638 */
void (*tcl_StoreIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjIntRep *irPtr); /* 639 */
int (*tcl_HasStringRep) (Tcl_Obj *objPtr); /* 640 */
void (*tcl_IncrRefCount) (Tcl_Obj *objPtr); /* 641 */
void (*tcl_DecrRefCount) (Tcl_Obj *objPtr); /* 642 */
int (*tcl_IsShared) (Tcl_Obj *objPtr); /* 643 */
int (*tcl_LinkArray) (Tcl_Interp *interp, const char *varName, void *addr, int type, int size); /* 644 */
|
| ︙ |
Changes to generic/tclExecute.c.
| ︙ | |||
4839 4840 4841 4842 4843 4844 4845 | 4839 4840 4841 4842 4843 4844 4845 4846 4847 4848 4849 4850 4851 4852 4853 | - + | /* * Extract the desired list element. */ if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK) && !TclHasIntRep(value2Ptr, &tclListType) && (TclGetIntForIndexM(NULL, value2Ptr, objc-1, |
| ︙ | |||
5278 5279 5280 5281 5282 5283 5284 | 5278 5279 5280 5281 5282 5283 5284 5285 5286 5287 5288 5289 5290 5291 5292 | - + |
TRACE(("\"%.20s\" %.20s => ", O2S(valuePtr), O2S(value2Ptr)));
/*
* Get char length to calulate what 'end' means.
*/
length = Tcl_GetCharLength(valuePtr);
|
| ︙ | |||
5319 5320 5321 5322 5323 5324 5325 | 5319 5320 5321 5322 5323 5324 5325 5326 5327 5328 5329 5330 5331 5332 5333 5334 5335 | - + - + |
NEXT_INST_F(1, 2, 1);
case INST_STR_RANGE:
TRACE(("\"%.20s\" %.20s %.20s =>",
O2S(OBJ_AT_DEPTH(2)), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
length = Tcl_GetCharLength(OBJ_AT_DEPTH(2)) - 1;
if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length,
|
| ︙ | |||
5408 5409 5410 5411 5412 5413 5414 | 5408 5409 5410 5411 5412 5413 5414 5415 5416 5417 5418 5419 5420 5421 5422 5423 5424 | - + - + |
case INST_STR_REPLACE:
value3Ptr = POP_OBJECT();
valuePtr = OBJ_AT_DEPTH(2);
endIdx = Tcl_GetCharLength(valuePtr) - 1;
TRACE(("\"%.20s\" %s %s \"%.20s\" => ", O2S(valuePtr),
O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(value3Ptr)));
if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, endIdx,
|
| ︙ | |||
6381 6382 6383 6384 6385 6386 6387 6388 6389 6390 6391 6392 6393 6394 | 6381 6382 6383 6384 6385 6386 6387 6388 6389 6390 6391 6392 6393 6394 6395 6396 6397 6398 6399 6400 6401 6402 6403 6404 6405 6406 6407 6408 6409 6410 6411 6412 6413 | + + + + + + + + + + + + + + + + + + + |
case INST_TRY_CVT_TO_BOOLEAN:
valuePtr = OBJ_AT_TOS;
if (TclHasIntRep(valuePtr, &tclBooleanType)) {
objResultPtr = TCONST(1);
} else {
int result = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK);
objResultPtr = TCONST(result);
}
TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(valuePtr)), objResultPtr);
NEXT_INST_F(1, 0, 1);
break;
case INST_TRY_CVT_TO_INDEX:
valuePtr = OBJ_AT_TOS;
if (TclHasIntRep(valuePtr, &tclIntType)) {
objResultPtr = TCONST(valuePtr->internalRep.wideValue >= -1);
} else {
int idx;
if (TclGetIntForIndexM(NULL, valuePtr, INT_MAX-1, TCL_INDEX_ERROR, &idx) != TCL_OK) {
objResultPtr = TCONST(0);
} else {
TclInvalidateStringRep(valuePtr);
valuePtr->typePtr = &tclIntType;
valuePtr->internalRep.wideValue = idx;
objResultPtr = TCONST(1);
}
}
TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(valuePtr)), objResultPtr);
NEXT_INST_F(1, 0, 1);
break;
case INST_BREAK:
/*
|
| ︙ |
Changes to generic/tclInt.h.
| ︙ | |||
2517 2518 2519 2520 2521 2522 2523 | 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 | + - - - - - - + + + + + + + + + + + + + + + |
#define TclGetIntFromObj(interp, objPtr, intPtr) \
(((objPtr)->typePtr == &tclIntType \
&& (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(INT_MIN) \
&& (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \
? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
: Tcl_GetIntFromObj((interp), (objPtr), (intPtr)))
#ifdef TCL_NO_DEPRECATED
|
| ︙ | |||
2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 | 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 | + | MODULE_SCOPE const Tcl_ObjType tclListType; MODULE_SCOPE const Tcl_ObjType tclDictType; MODULE_SCOPE const Tcl_ObjType tclProcBodyType; MODULE_SCOPE const Tcl_ObjType tclStringType; MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType; MODULE_SCOPE const Tcl_ObjType tclRegexpType; MODULE_SCOPE Tcl_ObjType tclCmdNameType; MODULE_SCOPE const Tcl_ObjType tclEndOffsetType; /* * Variables denoting the hash key types defined in the core. */ MODULE_SCOPE const Tcl_HashKeyType tclArrayHashKeyType; MODULE_SCOPE const Tcl_HashKeyType tclOneWordHashKeyType; |
| ︙ |
Changes to generic/tclListObj.c.
| ︙ | |||
1259 1260 1261 1262 1263 1264 1265 | 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 | - + |
* Determine whether argPtr designates a list or a single index. We have
* to be careful about the order of the checks to avoid repeated
* shimmering; see TIP#22 and TIP#33 for the details.
*/
ListGetIntRep(argPtr, listRepPtr);
if ((listRepPtr == NULL)
|
| ︙ | |||
1361 1362 1363 1364 1365 1366 1367 | 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 | - + - + | */ break; } TclListObjGetElements(NULL, sublistCopy, &listLen, &elemPtrs); if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1, |
| ︙ | |||
1440 1441 1442 1443 1444 1445 1446 | 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 | - + |
* Determine whether the index arg designates a list or a single index.
* We have to be careful about the order of the checks to avoid repeated
* shimmering; see TIP #22 and #23 for details.
*/
ListGetIntRep(indexArgPtr, listRepPtr);
if (listRepPtr == NULL
|
| ︙ | |||
1587 1588 1589 1590 1591 1592 1593 | 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 | - + | } /* * WARNING: the macro TclGetIntForIndexM is not safe for * post-increments, avoid '*indexArray++' here. */ |
| ︙ |
Changes to generic/tclNamesp.c.
| ︙ | |||
165 166 167 168 169 170 171 | 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 | - - + + |
{"export", NamespaceExportCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
{"forget", NamespaceForgetCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
{"import", NamespaceImportCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
{"inscope", NamespaceInscopeCmd, NULL, NRNamespaceInscopeCmd, NULL, 0},
{"origin", NamespaceOriginCmd, TclCompileNamespaceOriginCmd, NULL, NULL, 0},
{"parent", NamespaceParentCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
{"path", NamespacePathCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
|
| ︙ |
Changes to generic/tclStubInit.c.
| ︙ | |||
659 660 661 662 663 664 665 | 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 | - + + + + + + + + + + | # define TclBN_s_mp_sub 0 #else /* TCL_NO_DEPRECATED */ # define Tcl_SeekOld seekOld # define Tcl_TellOld tellOld # define TclBackgroundException Tcl_BackgroundException # define TclSetStartupScript Tcl_SetStartupScript # define TclGetStartupScript Tcl_GetStartupScript |
| ︙ |
Changes to generic/tclUtil.c.
| ︙ | |||
104 105 106 107 108 109 110 | 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 | - + - - - + | /* * Prototypes for functions defined later in this file. */ static void ClearHash(Tcl_HashTable *tablePtr); static void FreeProcessGlobalValue(ClientData clientData); static void FreeThreadHash(ClientData clientData); |
| ︙ | |||
3041 3042 3043 3044 3045 3046 3047 | 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 | - + |
void
Tcl_DStringGetResult(
Tcl_Interp *interp, /* Interpreter whose result is to be reset. */
Tcl_DString *dsPtr) /* Dynamic string that is to become the result
* of interp. */
{
|
| ︙ | |||
3644 3645 3646 3647 3648 3649 3650 | 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 | - + |
}
return numFormatted;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | |||
3667 3668 3669 3670 3671 3672 3673 | 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 3716 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 3729 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 | - - + + + + - - - - - - - - - + - - - - + - - + - - - - - + + - - + - - - - - - - + - - - - - - + - - - - - - + + + + - - - - - + - - + - - - + - - - - - - + - - - - + - - - - - + + - - - - - - + + - - - - + - - - + - - - + + + + - - - - - - - - - + - - - + + + + - - - - + + + + - - - - - - - + - - - - - - - - - - - - + - - - - - - - - - - - - - - - - - - - - - - + - - - + + - - - + | * * Side effects: * The type of *objPtr may change. * *---------------------------------------------------------------------- */ |
| ︙ | |||
3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 | 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 3845 3846 3847 3848 3849 3850 3851 3852 3853 3854 3855 3856 3857 3858 3859 3860 3861 3862 3863 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 3920 3921 3922 3923 3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 3952 3953 3954 3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975 3976 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 3997 3998 3999 4000 4001 4002 4003 4004 4005 4006 4007 4008 4009 4010 4011 4012 4013 4014 4015 4016 4017 4018 4019 4020 4021 4022 4023 4024 4025 4026 4027 4028 4029 4030 4031 4032 4033 4034 4035 4036 4037 4038 4039 4040 4041 4042 4043 4044 4045 4046 4047 4048 4049 4050 4051 4052 4053 4054 4055 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 4090 4091 | + - + - - + + + + + + + + + + + + + + - + + - + + + + + - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + - + - + + + + + + + + + + + + + - + + + + + - - + + - - - - + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + |
Tcl_Interp *interp, /* Interpreter to use for error reporting. If
* NULL, then no error message is left after
* errors. */
Tcl_Obj *objPtr, /* Points to an object containing either "end"
* or an integer. */
int endValue, /* The value to be stored at "indexPtr" if
* "objPtr" holds "end". */
int flags,
int *indexPtr) /* Location filled in with an integer
* representing an index. */
{
Tcl_WideInt wide;
|
| ︙ | |||
4054 4055 4056 4057 4058 4059 4060 | 4143 4144 4145 4146 4147 4148 4149 4150 4151 4152 4153 4154 4155 4156 4157 4158 4159 4160 4161 4162 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 | - - + + - - - + + + - - - - - - - + - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + - - - - - - - - - - |
TclIndexEncode(
Tcl_Interp *interp, /* For error reporting, may be NULL */
Tcl_Obj *objPtr, /* Index value to parse */
int before, /* Value to return for index before beginning */
int after, /* Value to return for index after end */
int *indexPtr) /* Where to write the encoded answer, not NULL */
{
|
| ︙ |
Changes to tests/assemble.test.
| ︙ | |||
27 28 29 30 31 32 33 34 35 36 37 38 39 40 | 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 | + |
for {set i 0} {$i < 256} {incr i} {
append s $sep [list set v$i literal$i]
set sep \n
}
return $s
}
testConstraint nodep [info exists tcl_precision]
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
proc getbytes {} {
set lines [split [memory info] \n]
return [lindex $lines 3 3]
}
proc leaktest {script {iterations 3}} {
|
| ︙ | |||
1555 1556 1557 1558 1559 1560 1561 | 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 | - + - + |
} -result c
test assemble-15.6 {listIndexImm} -body {
assemble {push {a b c}; listIndexImm end-1}
} -result b
test assemble-15.7 {listIndexImm} -body {
assemble {push {a b c}; listIndexImm end}
} -result c
|
| ︙ |
Changes to tests/cmdIL.test.
| ︙ | |||
59 60 61 62 63 64 65 | 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 | - + |
lsort -decreasing -increasing {d e c b a d35 d300}
} {a b c d d300 d35 e}
test cmdIL-1.11 {Tcl_LsortObjCmd procedure, -index option} -body {
lsort -index {1 3 2 5}
} -returnCodes error -result {"-index" option must be followed by list index}
test cmdIL-1.12 {Tcl_LsortObjCmd procedure, -index option} -body {
lsort -index foo {1 3 2 5}
|
| ︙ | |||
795 796 797 798 799 800 801 | 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 | - + - + |
lremove
} -result {wrong # args: should be "lremove list ?index ...?"}
test cmdIL-8.2 {lremove command: error path} -returnCodes error -body {
lremove {{}{}}
} -result {list element in braces followed by "{}" instead of space}
test cmdIL-8.3 {lremove command: error path} -returnCodes error -body {
lremove {a b c} gorp
|
| ︙ |
Changes to tests/compile.test.
| ︙ | |||
313 314 315 316 317 318 319 | 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 | - + - + |
test compile-11.1 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
apply {{} {
# shared object - Interp result && Var 'r'
set r [list foobar]
# command that will add error to result
lindex a bogus
}}
|
| ︙ |
Changes to tests/lindex.test.
| ︙ | |||
18 19 20 21 22 23 24 25 26 27 28 29 30 31 | 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 | + |
}
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
set minus -
testConstraint testevalex [llength [info commands testevalex]]
testConstraint nodep [info exists tcl_precision]
# Tests of Tcl_LindexObjCmd, NOT COMPILED
test lindex-1.1 {wrong # args} testevalex {
list [catch {testevalex lindex} result] $result
} "1 {wrong # args: should be \"lindex list ?index ...?\"}"
|
| ︙ | |||
43 44 45 46 47 48 49 | 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 | - + |
set x {1 2}
list [testevalex {lindex {{a b c} {d e f}} $x}] \
[testevalex {lindex {{a b c} {d e f}} $x}]
} {f f}
test lindex-2.4 {malformed index list} testevalex {
set x \{
list [catch { testevalex {lindex {a b c} $x} } result] $result
|
| ︙ | |||
78 79 80 81 82 83 84 | 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 | - + - + |
test lindex-3.7 {indexes don't shimmer wide ints} -body {
set x [expr {(wide(1)<<31) - 2}]
list $x [lindex {1 2 3} $x] [incr x] [incr x]
} -result {2147483646 {} 2147483647 2147483648}
test lindex-3.8 {compiled with static indices out of range, negative} -body {
list [lindex {a b c} -1] [lindex {a b c} -2] [lindex {a b c} -3]
} -result [lrepeat 3 {}]
|
| ︙ | |||
118 119 120 121 122 123 124 | 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 | - + - + - + |
test lindex-4.7 {bad octal} -constraints testevalex -body {
set x end--0o9
list [catch { testevalex {lindex {a b c} $x} } result] $result
} -match glob -result {1 {*invalid octal number*}}
test lindex-4.8 {bad integer, not octal} testevalex {
set x end-0a2
list [catch { testevalex {lindex {a b c} $x} } result] $result
|
| ︙ | |||
235 236 237 238 239 240 241 | 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 | - + |
list [lindex {{a b c} {d e f}} $x] [lindex {{a b c} {d e f}} $x]
} result
set result
} {f f}
test lindex-10.4 {malformed index list} {
set x \{
list [catch { lindex {a b c} $x } result] $result
|
| ︙ | |||
324 325 326 327 328 329 330 | 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 | - + - + - + |
test lindex-12.7 {bad octal} -body {
set x end--0o9
list [catch { lindex {a b c} $x } result] $result
} -match glob -result {1 {*invalid octal number*}}
test lindex-12.8 {bad integer, not octal} {
set x end-0a2
list [catch { lindex {a b c} $x } result] $result
|
| ︙ |
Changes to tests/linsert.test.
| ︙ | |||
81 82 83 84 85 86 87 | 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 | - + - + |
} {a b e f c d}
test linsert-2.1 {linsert errors} {
list [catch linsert msg] $msg
} {1 {wrong # args: should be "linsert list index ?element ...?"}}
test linsert-2.2 {linsert errors} {
list [catch {linsert a b} msg] $msg
|
| ︙ |
Changes to tests/lrange.test.
| ︙ | |||
16 17 18 19 20 21 22 23 24 25 26 27 28 29 | 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | + |
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
testConstraint testpurebytesobj [llength [info commands testpurebytesobj]]
testConstraint nodep [info exists tcl_precision]
test lrange-1.1 {range of list elements} {
lrange {a b c d} 1 2
} {b c}
test lrange-1.2 {range of list elements} {
lrange {a {bcd e {f g {}}} l14 l15 d} 1 1
} {{bcd e {f g {}}}}
|
| ︙ | |||
75 76 77 78 79 80 81 | 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 | - + - + - + - - + + - - + - + - + - - + + - + - - + + - + - + |
list [catch {lrange a b} msg] $msg
} {1 {wrong # args: should be "lrange list first last"}}
test lrange-2.2 {error conditions} {
list [catch {lrange a b 6 7} msg] $msg
} {1 {wrong # args: should be "lrange list first last"}}
test lrange-2.3 {error conditions} {
list [catch {lrange a b 6} msg] $msg
|
| ︙ | |||
208 209 210 211 212 213 214 | 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 | - + |
# Testing for compiled vs non-compiled behaviour, and shared vs non-shared.
# Far too many variations to check with spelt-out tests.
# Note that this *just* checks whether the different versions are the same
# not whether any of them is correct.
apply {{} {
set lss {{} {a} {a b c} {a b c d}}
|
| ︙ |
Changes to tests/lreplace.test.
| ︙ | |||
115 116 117 118 119 120 121 | 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 | - + - + - + |
list [catch lreplace msg] $msg
} -result {1 {wrong # args: should be "lreplace list first last ?element ...?"}}
test lreplace-2.2 {lreplace errors} -body {
list [catch {lreplace a b} msg] $msg
} -result {1 {wrong # args: should be "lreplace list first last ?element ...?"}}
test lreplace-2.3 {lreplace errors} -body {
list [catch {lreplace x a 10} msg] $msg
|
| ︙ | |||
213 214 215 216 217 218 219 | 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 | - + |
# Testing for compiled behaviour. Far too many variations to check with
# spelt-out tests. Note that this *just* checks whether the compiled version
# and the interpreted version are the same, not whether the interpreted
# version is correct.
apply {{} {
set lss {{} {a} {a b c} {a b c d}}
set ins {{} A {A B}}
|
| ︙ |
Changes to tests/lsearch.test.
| ︙ | |||
296 297 298 299 300 301 302 | 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 | - + |
lsearch -start 2 {a b c d e f} a
} -1
test lsearch-10.3 {offset searching} {
lsearch -start end-4 {a b c a b c} a
} 3
test lsearch-10.4 {offset searching} -returnCodes error -body {
lsearch -start foobar {a b c a b c} a
|
| ︙ | |||
489 490 491 492 493 494 495 | 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 | - + |
} {{0 1}}
test lsearch-20.1 {lsearch -index option, index larger than sublists} -body {
lsearch -index 2 {{a c} {a b} {a a}} a
} -returnCodes error -result {element 2 missing from sublist "a c"}
test lsearch-20.2 {lsearch -index option, malformed index} -body {
lsearch -index foo {{a c} {a b} {a a}} a
|
| ︙ |
Changes to tests/lset.test.
| ︙ | |||
45 46 47 48 49 50 51 | 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 | - + |
list [testevalex {lset x 0 3}] $x
} {{3 1 2} {3 1 2}}
test lset-2.2 {lset, not compiled, 3 args, second arg neither index nor list} testevalex {
set x {0 1 2}
list [catch {
testevalex {lset x {{bad}1} 3}
} msg] $msg
|
| ︙ | |||
87 88 89 90 91 92 93 | 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 | - + |
} msg] $msg
} {1 {unmatched open brace in list}}
test lset-4.2 {lset, not compiled, 3 args, bad index} testevalex {
set a {x y z}
list [catch {
testevalex {lset a [list 2a2] w}
} msg] $msg
|
| ︙ | |||
129 130 131 132 133 134 135 | 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 | - + |
} msg] $msg
} {1 {unmatched open brace in list}}
test lset-4.8 {lset, not compiled, 3 args, bad index} testevalex {
set a {x y z}
list [catch {
testevalex {lset a 2a2 w}
} msg] $msg
|
| ︙ | |||
269 270 271 272 273 274 275 | 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 | - + - + |
test lset-8.2 {lset, not compiled, malformed sublist} testevalex {
set a [list "a \{" b]
list [catch {testevalex {lset a {0 1} c}} msg] $msg
} {1 {unmatched open brace in list}}
test lset-8.3 {lset, not compiled, bad second index} testevalex {
set a {{b c} {d e}}
list [catch {testevalex {lset a 0 2a2 f}} msg] $msg
|
| ︙ |
Changes to tests/regexp.test.
| ︙ | |||
278 279 280 281 282 283 284 | 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 | - + |
unset -nocomplain f1
} -body {
set f1 44
regexp abc abc f1(f2)
} -returnCodes error -result {can't set "f1(f2)": variable isn't array}
test regexp-6.9 {regexp errors, -start bad int check} {
list [catch {regexp -start bogus {^$} {}} msg] $msg
|
| ︙ | |||
475 476 477 478 479 480 481 | 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 | - + |
unset -nocomplain f1
} -body {
set f1 44
regsub -nocase aaa aaa xxx f1(f2)
} -returnCodes error -result {can't set "f1(f2)": variable isn't array}
test regexp-11.8 {regsub errors, -start bad int check} {
list [catch {regsub -start bogus pattern string rep var} msg] $msg
|
| ︙ | |||
540 541 542 543 544 545 546 | 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 | - + |
exec [interpreter] $junk
} -cleanup {
removeFile junk.tcl
} -result 1
test regexp-15.1 {regexp -start} -body {
unset -nocomplain x
|
| ︙ | |||
586 587 588 589 590 591 592 | 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 | - + |
test regexp-16.1 {regsub -start} -body {
unset -nocomplain x
list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x
} -result {4 a1b/2c/3d/4e/5}
test regexp-16.2 {regsub -start} -body {
unset -nocomplain x
|
| ︙ | |||
651 652 653 654 655 656 657 | 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 | - + |
} -result {1 xy}
test regexp-16.18 {regsub -start} -body {
set foo {}
list [regsub -start 1 y+ "xy" & foo] $foo
} -result {1 xy}
test regexp-16.19 {regsub -start} -body {
set foo {}
|
| ︙ |
Changes to tests/regexpComp.test.
| ︙ | |||
354 355 356 357 358 359 360 | 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 | - + |
list [catch {regexp abc abc f1(f2)} msg] $msg
}
} {1 {can't set "f1(f2)": variable isn't array}}
test regexpComp-6.9 {regexp errors, -start bad int check} {
evalInProc {
list [catch {regexp -start bogus {^$} {}} msg] $msg
}
|
| ︙ | |||
600 601 602 603 604 605 606 | 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 | - + |
list [catch {regsub -nocase aaa aaa xxx f1(f2)} msg] $msg
}
} {1 {can't set "f1(f2)": variable isn't array}}
test regexpComp-11.8 {regsub errors, -start bad int check} {
evalInProc {
list [catch {regsub -start bogus pattern string rep var} msg] $msg
}
|
| ︙ | |||
663 664 665 666 667 668 669 | 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 | - + |
exec [interpreter] $junk
} -cleanup {
removeFile junk.tcl
} -result 1
test regexpComp-15.1 {regexp -start} -body {
unset -nocomplain x
|
| ︙ | |||
691 692 693 694 695 696 697 | 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 | - + |
test regexpComp-16.1 {regsub -start} -body {
unset -nocomplain x
list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x
} -result {4 a1b/2c/3d/4e/5}
test regexpComp-16.2 {regsub -start} -body {
unset -nocomplain x
|
| ︙ |
Changes to tests/string.test.
| ︙ | |||
28 29 30 31 32 33 34 35 36 37 38 39 40 41 | 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 | + + |
# Some tests require the testobj command
testConstraint testobj [expr {[info commands testobj] ne {}}]
testConstraint testindexobj [expr {[info commands testindexobj] ne {}}]
testConstraint testevalex [expr {[info commands testevalex] ne {}}]
testConstraint tip389 [expr {[string length \U010000] == 2}]
testConstraint nodep [info exists tcl_precision]
testConstraint deprecated [expr {![info exists tcl_precision]}]
# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
proc getbytes {} {
set lines [split [memory info] \n]
return [lindex $lines 3 3]
|
| ︙ | |||
366 367 368 369 370 371 372 | 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 | - + |
test string-4.1.$noComp {string first, too few args} {
list [catch {run {string first a}} msg] $msg
} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
test string-4.2.$noComp {string first, bad args} {
list [catch {run {string first a b c}} msg] $msg
|
| ︙ | |||
401 402 403 404 405 406 407 | 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 | - + - + - + |
test string-4.12.$noComp {string first, start index} -body {
run {string first \u7266 abc\u7266x 4}
} -result -1
test string-4.13.$noComp {string first, start index} -body {
run {string first \u7266 abc\u7266x end-2}
} -result 3
test string-4.14.$noComp {string first, negative start index} -body {
|
| ︙ | |||
452 453 454 455 456 457 458 | 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 | - + - + |
test string-5.4.$noComp {string index} {
run {string ind abcde 4}
} e
test string-5.5.$noComp {string index} {
run {string index abcde 5}
} {}
test string-5.6.$noComp {string index} {
|
| ︙ | |||
496 497 498 499 500 501 502 | 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 | - + |
test string-5.17.$noComp {string index, bad integer} -body {
list [catch {run {string index "abc" 0o8}} msg] $msg
} -match glob -result {1 {*invalid octal number*}}
test string-5.18.$noComp {string index, bad integer} -body {
list [catch {run {string index "abc" end-0o0289}} msg] $msg
} -match glob -result {1 {*invalid octal number*}}
test string-5.19.$noComp {string index, bytearray object out of bounds} {
|
| ︙ | |||
529 530 531 532 533 534 535 | 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 | - + - + |
list [catch {run {string is alpha -failin str}} msg] $msg
} {1 {wrong # args: should be "string is alpha ?-strict? ?-failindex var? str"}}
test string-6.4.$noComp {string is, too many args} {
list [catch {run {string is alpha -failin var -strict str more}} msg] $msg
} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
test string-6.5.$noComp {string is, class check} {
list [catch {run {string is bogus str}} msg] $msg
|
| ︙ | |||
965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 | 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 | + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + |
} {0 87}
test string-6.130.1.$noComp {string is entier, false on bad octal} {
list [run {string is entier -fail var 0o1234561123412345612345656234561234561234561234561234561234561234561234561234561234536963}] $var
} {0 87}
test string-6.131.$noComp {string is entier, false on bad hex} {
list [run {string is entier -fail var 0X12345611234123456123456562345612345612345612345612345612345612345612345612345612345345XYZ}] $var
} {0 88}
test string-6.132.$noComp {string is index, true} {
run {string is index +1234567890}
} 1
test string-6.133.$noComp {string is index, true} {
run {string is index 1}
} 1
test string-6.134.$noComp {string is index, true} {
run {string is index 0}
} 1
test string-6.135.$noComp {string is index, true} {
run {string is index -1}
} 1
test string-6.136.$noComp {string is index, false} {
run {string is index -2}
} 0
test string-6.137.$noComp {string is index, false} {
run {string is index end+2}
} 0
test string-6.138.$noComp {string is index, true} {
run {string is index end+1}
} 1
test string-6.139.$noComp {string is index, true} {
run {string is index end-9999999}
} 1
test string-6.140.$noComp {string is index, true} {
run {string is index none}
} 1
test string-6.141.$noComp {string is none, false} {
run {string is none +1234567890}
} 0
test string-6.142.$noComp {string is none, false} {
run {string is none 1}
} 0
test string-6.143.$noComp {string is none, false} {
run {string is none 0}
} 0
test string-6.144.$noComp {string is none, true} -constraints nodep -body {
run {string is none 1-2}
} -result 1
test string-6.145.$noComp {string is none, true} {
run {string is none -1}
} 1
test string-6.146.$noComp {string is none, false} {
run {string is none -2}
} 0
test string-6.147.$noComp {string is none, false} {
run {string is none end+2}
} 0
test string-6.148.$noComp {string is none, false} {
run {string is none end+1}
} 0
test string-6.149.$noComp {string is none, true} {
run {string is none none}
} 1
catch {rename largest_int {}}
test string-7.1.$noComp {string last, too few args} {
list [catch {run {string last a}} msg] $msg
} {1 {wrong # args: should be "string last needleString haystackString ?lastIndex?"}}
test string-7.2.$noComp {string last, bad args} {
list [catch {run {string last a b c}} msg] $msg
|
| ︙ | |||
1436 1437 1438 1439 1440 1441 1442 | 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 | - + - + - + - + - + |
test string-12.6.$noComp {string range} {
run {string range abcdefghijklmnop 10 end}
} {klmnop}
test string-12.7.$noComp {string range, last < first} {
run {string range abcdefghijklmnop 10 9}
} {}
test string-12.8.$noComp {string range, first < 0} {
|
| ︙ | |||
1570 1571 1572 1573 1574 1575 1576 | 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 | - + - + - + - + - + - + |
test string-14.7.$noComp {string replace} {
run {string replace abcdefghijklmnop 10 end}
} {abcdefghij}
test string-14.8.$noComp {string replace} {
run {string replace abcdefghijklmnop 10 9}
} {abcdefghijklmnop}
test string-14.9.$noComp {string replace} {
|
| ︙ | |||
1652 1653 1654 1655 1656 1657 1658 | 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 | - + |
} 3
test string-15.1.$noComp {string tolower too few args} {
list [catch {run {string tolower}} msg] $msg
} {1 {wrong # args: should be "string tolower string ?first? ?last?"}}
test string-15.2.$noComp {string tolower bad args} {
list [catch {run {string tolower a b}} msg] $msg
|
| ︙ | |||
1686 1687 1688 1689 1690 1691 1692 | 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 | - + |
} b
test string-16.1.$noComp {string toupper} {
list [catch {run {string toupper}} msg] $msg
} {1 {wrong # args: should be "string toupper string ?first? ?last?"}}
test string-16.2.$noComp {string toupper} {
list [catch {run {string toupper a b}} msg] $msg
|
| ︙ | |||
1720 1721 1722 1723 1724 1725 1726 | 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 | - + |
} B
test string-17.1.$noComp {string totitle} {
list [catch {run {string totitle}} msg] $msg
} {1 {wrong # args: should be "string totitle string ?first? ?last?"}}
test string-17.2.$noComp {string totitle} {
list [catch {run {string totitle a b}} msg] $msg
|
| ︙ | |||
1818 1819 1820 1821 1822 1823 1824 | 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 | - + - + |
list [catch {run {string wordend a}} msg] $msg
} -result {1 {wrong # args: should be "string wordend string index"}}
test string-21.2.$noComp {string wordend} -body {
list [catch {run {string wordend a b c}} msg] $msg
} -result {1 {wrong # args: should be "string wordend string index"}}
test string-21.3.$noComp {string wordend} -body {
list [catch {run {string wordend a gorp}} msg] $msg
|
| ︙ | |||
1864 1865 1866 1867 1868 1869 1870 | 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 | - + - + |
list [catch {run {string wordstart a}} msg] $msg
} -result {1 {wrong # args: should be "string wordstart string index"}}
test string-22.3.$noComp {string wordstart} -body {
list [catch {run {string wordstart a b c}} msg] $msg
} -result {1 {wrong # args: should be "string wordstart string index"}}
test string-22.4.$noComp {string wordstart} -body {
list [catch {run {string wordstart a gorp}} msg] $msg
|
| ︙ | |||
2359 2360 2361 2362 2363 2364 2365 | 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 | - + |
test string-31.8.$noComp {string insert, empty insert string} {
run {tcl::string::insert 0123 0 {}}
} 0123
test string-31.9.$noComp {string insert, empty strings} {
run {tcl::string::insert {} 0 {}}
} {}
test string-31.10.$noComp {string insert, negative index} {
|
| ︙ |
Changes to tests/util.test.
| ︙ | |||
19 20 21 22 23 24 25 | 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | - + |
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testdstring [llength [info commands testdstring]]
testConstraint testconcatobj [llength [info commands testconcatobj]]
testConstraint testdoubledigits [llength [info commands testdoubledigits]]
testConstraint testprint [llength [info commands testprint]]
testConstraint precision [expr {![catch {set saved_precision $::tcl_precision}]}]
|
| ︙ | |||
728 729 730 731 732 733 734 | 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 | - + - + - + - + |
} -returnCodes error -match glob -result *
test util-9.43 {Tcl_GetIntForIndex} -body {
string index a 0+1.5e1
} -returnCodes error -match glob -result *
test util-9.44 {Tcl_GetIntForIndex} -body {
string index a 0+1000000000000
} -result {}
|
| ︙ | |||
768 769 770 771 772 773 774 | 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 | - + |
} -result {}
test util-9.56 {Tcl_GetIntForIndex} -body {
string index abcd end--0x10000000000000000
} -result {}
test util-9.57 {Tcl_GetIntForIndex} {
string index abcd end+-0x10000000000000000
} {}
|
| ︙ |