ag/cpython-source-deps
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Import Tcl 8.6.10

Browse Source
This commit is contained in:
Steve Dower
2020-09-24 22:53:56 +01:00
parent 0343d03b22
commit 3bb8e3e086
1005 changed files with 593700 additions and 41637 deletions
Download Patch File Download Diff File Expand all files Collapse all files

100
generic/tclCmdIL.c
View File

@@ -64,8 +64,9 @@ typedef struct SortInfo {
* SORTMODE_COMMAND. Pre-initialized to hold
* base of command. */
int *indexv; /* If the -index option was specified, this
* holds the indexes contained in the list
* supplied as an argument to that option.
* holds an encoding of the indexes contained
* in the list supplied as an argument to
* that option.
* NULL if no indexes supplied, and points to
* singleIndex field when only one
* supplied. */
@@ -92,14 +93,6 @@ typedef struct SortInfo {
#define SORTMODE_DICTIONARY 4
#define SORTMODE_ASCII_NC 8
/*
* Magic values for the index field of the SortInfo structure. Note that the
* index "end-1" will be translated to SORTIDX_END-1, etc.
*/
#define SORTIDX_NONE -1 /* Not indexed; use whole value. */
#define SORTIDX_END -2 /* Indexed from end. */
/*
* Forward declarations for procedures defined in this file:
*/
@@ -1967,7 +1960,7 @@ InfoProcsCmd(
/*
* If "info procs" worked like "info commands", returning the commands
* also seen in the global namespace, then you would include this
* code. As this could break backwards compatibilty with 8.0-8.2, we
* code. As this could break backwards compatibility with 8.0-8.2, we
* decided not to "fix" it in 8.3, leaving the behavior slightly
* different.
*/
@@ -2754,21 +2747,10 @@ Tcl_LreplaceObjCmd(
if (first < 0) {
first = 0;
}
/*
* Complain if the user asked for a start element that is greater than the
* list length. This won't ever trigger for the "end-*" case as that will
* be properly constrained by TclGetIntForIndex because we use listLen-1
* (to allow for replacing the last elem).
*/
if ((first > listLen) && (listLen > 0)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"list doesn't contain element %s", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPLACE", "BADIDX",
NULL);
return TCL_ERROR;
if (first > listLen) {
first = listLen;
}
if (last >= listLen) {
last = listLen - 1;
}
@@ -2913,7 +2895,7 @@ Tcl_LsearchObjCmd(
Tcl_Obj *const objv[]) /* Argument values. */
{
const char *bytes, *patternBytes;
int i, match, index, result, listc, length, elemLen, bisect;
int i, match, index, result=TCL_OK, listc, length, elemLen, bisect;
int dataType, isIncreasing, lower, upper, offset;
Tcl_WideInt patWide, objWide;
int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
@@ -3113,13 +3095,26 @@ Tcl_LsearchObjCmd(
*/
for (j=0 ; j<sortInfo.indexc ; j++) {
if (TclGetIntForIndexM(interp, indices[j], SORTIDX_END,
&sortInfo.indexv[j]) != TCL_OK) {
int encoded = 0;
if (TclIndexEncode(interp, indices[j], TCL_INDEX_BEFORE,
TCL_INDEX_AFTER, &encoded) != TCL_OK) {
result = TCL_ERROR;
}
if ((encoded == TCL_INDEX_BEFORE)
|| (encoded == TCL_INDEX_AFTER)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"index \"%s\" cannot select an element "
"from any list", Tcl_GetString(indices[j])));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX"
"OUTOFRANGE", NULL);
result = TCL_ERROR;
}
if (result == TCL_ERROR) {
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (-index option item number %d)", j));
result = TCL_ERROR;
goto done;
}
sortInfo.indexv[j] = encoded;
}
break;
}
@@ -3492,8 +3487,8 @@ Tcl_LsearchObjCmd(
itemPtr = Tcl_NewIntObj(i);
for (j=0 ; j<sortInfo.indexc ; j++) {
Tcl_ListObjAppendElement(interp, itemPtr,
Tcl_NewIntObj(sortInfo.indexv[j]));
Tcl_ListObjAppendElement(interp, itemPtr, Tcl_NewIntObj(
TclIndexDecode(sortInfo.indexv[j], listc)));
}
Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
} else {
@@ -3514,8 +3509,8 @@ Tcl_LsearchObjCmd(
itemPtr = Tcl_NewIntObj(index);
for (j=0 ; j<sortInfo.indexc ; j++) {
Tcl_ListObjAppendElement(interp, itemPtr,
Tcl_NewIntObj(sortInfo.indexv[j]));
Tcl_ListObjAppendElement(interp, itemPtr, Tcl_NewIntObj(
TclIndexDecode(sortInfo.indexv[j], listc)));
}
Tcl_SetObjResult(interp, itemPtr);
} else {
@@ -3732,7 +3727,7 @@ Tcl_LsortObjCmd(
sortInfo.isIncreasing = 1;
break;
case LSORT_INDEX: {
int indexc, dummy;
int indexc;
Tcl_Obj **indexv;
if (i == objc-2) {
@@ -3758,8 +3753,20 @@ Tcl_LsortObjCmd(
*/
for (j=0 ; j<indexc ; j++) {
if (TclGetIntForIndexM(interp, indexv[j], SORTIDX_END,
&dummy) != TCL_OK) {
int encoded = 0;
int result = TclIndexEncode(interp, indexv[j],
TCL_INDEX_BEFORE, TCL_INDEX_AFTER, &encoded);
if ((result == TCL_OK) && ((encoded == TCL_INDEX_BEFORE)
|| (encoded == TCL_INDEX_AFTER))) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"index \"%s\" cannot select an element "
"from any list", Tcl_GetString(indexv[j])));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX"
"OUTOFRANGE", NULL);
result = TCL_ERROR;
}
if (result == TCL_ERROR) {
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (-index option item number %d)", j));
sortInfo.resultCode = TCL_ERROR;
@@ -3839,8 +3846,8 @@ Tcl_LsortObjCmd(
* might be decreased by 1 later. */
}
for (j=0 ; j<sortInfo.indexc ; j++) {
TclGetIntForIndexM(interp, indexv[j], SORTIDX_END,
&sortInfo.indexv[j]);
/* Prescreened values, no errors or out of range possible */
TclIndexEncode(NULL, indexv[j], 0, 0, &sortInfo.indexv[j]);
}
}
@@ -3911,10 +3918,7 @@ Tcl_LsortObjCmd(
* offset of the element within each group by which to sort.
*/
groupOffset = sortInfo.indexv[0];
if (groupOffset <= SORTIDX_END) {
groupOffset = (groupOffset - SORTIDX_END) + groupSize - 1;
}
groupOffset = TclIndexDecode(sortInfo.indexv[0], groupSize - 1);
if (groupOffset < 0 || groupOffset >= groupSize) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"when used with \"-stride\", the leading \"-index\""
@@ -3933,6 +3937,9 @@ Tcl_LsortObjCmd(
/*
* Do not shrink the actual memory block used; that doesn't
* work with TclStackAlloc-allocated memory. [Bug 2918962]
*
* TODO: Consider a pointer increment to replace this
* array shift.
*/
for (i = 0; i < sortInfo.indexc; i++) {
@@ -4501,15 +4508,8 @@ SelectObjFromSublist(
infoPtr->resultCode = TCL_ERROR;
return NULL;
}
index = infoPtr->indexv[i];
/*
* Adjust for end-based indexing.
*/
if (index < SORTIDX_NONE) {
index += listLen + 1;
}
index = TclIndexDecode(infoPtr->indexv[i], listLen - 1);
if (Tcl_ListObjIndex(infoPtr->interp, objPtr, index,
&currentObj) != TCL_OK) {