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

104
generic/tclTest.c
View File

@@ -220,6 +220,12 @@ static void SpecialFree(char *blockPtr);
static int StaticInitProc(Tcl_Interp *interp);
static int TestasyncCmd(ClientData dummy,
Tcl_Interp *interp, int argc, const char **argv);
static int TestbumpinterpepochObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static int TestpurebytesobjObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static int TestbytestringObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -570,6 +576,7 @@ Tcltest_Init(
Tcl_CreateObjCommand(interp, "gettimes", GetTimesObjCmd, NULL, NULL);
Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testpurebytesobj", TestpurebytesobjObjCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd,
NULL, NULL);
@@ -580,6 +587,8 @@ Tcltest_Init(
Tcl_CreateObjCommand(interp, "testgetindexfromobjstruct",
TestGetIndexFromObjStructObjCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testasync", TestasyncCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testbumpinterpepoch",
TestbumpinterpepochObjCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testchannel", TestChannelCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testchannelevent", TestChannelEventCmd,
@@ -948,8 +957,10 @@ AsyncHandlerProc(
Tcl_MutexLock(&asyncTestMutex);
for (asyncPtr = firstHandler; asyncPtr != NULL;
asyncPtr = asyncPtr->nextPtr) {
if (asyncPtr->id == id) break;
asyncPtr = asyncPtr->nextPtr) {
if (asyncPtr->id == id) {
break;
}
}
Tcl_MutexUnlock(&asyncTestMutex);
@@ -1016,6 +1027,22 @@ AsyncThreadProc(
}
#endif
static int
TestbumpinterpepochObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *)interp;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, "");
return TCL_ERROR;
}
iPtr->compileEpoch++;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
@@ -2081,7 +2108,7 @@ TestevalexObjCmd(
flags = 0;
if (objc == 3) {
const char *global = Tcl_GetStringFromObj(objv[2], &length);
const char *global = Tcl_GetString(objv[2]);
if (strcmp(global, "global") != 0) {
Tcl_AppendResult(interp, "bad value \"", global,
"\": must be global", NULL);
@@ -2378,11 +2405,11 @@ ExitProcOdd(
ClientData clientData) /* Integer value to print. */
{
char buf[16 + TCL_INTEGER_SPACE];
size_t len;
int len;
sprintf(buf, "odd %d\n", PTR2INT(clientData));
sprintf(buf, "odd %d\n", (int)PTR2INT(clientData));
len = strlen(buf);
if (len != (size_t) write(1, buf, len)) {
if (len != (int) write(1, buf, len)) {
Tcl_Panic("ExitProcOdd: unable to write to stdout");
}
}
@@ -2392,11 +2419,11 @@ ExitProcEven(
ClientData clientData) /* Integer value to print. */
{
char buf[16 + TCL_INTEGER_SPACE];
size_t len;
int len;
sprintf(buf, "even %d\n", PTR2INT(clientData));
sprintf(buf, "even %d\n", (int)PTR2INT(clientData));
len = strlen(buf);
if (len != (size_t) write(1, buf, len)) {
if (len != (int) write(1, buf, len)) {
Tcl_Panic("ExitProcEven: unable to write to stdout");
}
}
@@ -4343,7 +4370,7 @@ TesttranslatefilenameCmd(
*
* TestupvarCmd --
*
* This procedure implements the "testupvar2" command. It is used
* This procedure implements the "testupvar" command. It is used
* to test Tcl_UpVar and Tcl_UpVar2.
*
* Results:
@@ -4956,6 +4983,57 @@ NoopObjCmd(
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TestpurebytesobjObjCmd --
*
* This object-based procedure constructs a pure bytes object
* without type and with internal representation containing NULL's.
*
* If no argument supplied it returns empty object with tclEmptyStringRep,
* otherwise it returns this as pure bytes object with bytes value equal
* string.
*
* Results:
* Returns the TCL_OK result code.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
TestpurebytesobjObjCmd(
ClientData unused, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
Tcl_Obj *objPtr;
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?string?");
return TCL_ERROR;
}
objPtr = Tcl_NewObj();
/*
objPtr->internalRep.twoPtrValue.ptr1 = NULL;
objPtr->internalRep.twoPtrValue.ptr2 = NULL;
*/
memset(&objPtr->internalRep, 0, sizeof(objPtr->internalRep));
if (objc == 2) {
const char *s = Tcl_GetString(objv[1]);
objPtr->length = objv[1]->length;
objPtr->bytes = ckalloc(objPtr->length + 1);
memcpy(objPtr->bytes, s, objPtr->length);
objPtr->bytes[objPtr->length] = 0;
}
Tcl_SetObjResult(interp, objPtr);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
@@ -5234,7 +5312,7 @@ TestmainthreadCmd(
const char **argv) /* Argument strings. */
{
if (argc == 1) {
Tcl_Obj *idObj = Tcl_NewLongObj((long)(size_t)Tcl_GetCurrentThread());
Tcl_Obj *idObj = Tcl_NewWideIntObj((Tcl_WideInt)(size_t)Tcl_GetCurrentThread());
Tcl_SetObjResult(interp, idObj);
return TCL_OK;
@@ -5631,8 +5709,8 @@ TestChannelCmd(
return TCL_ERROR;
}
TclFormatInt(buf, (size_t) Tcl_GetChannelThread(chan));
Tcl_AppendResult(interp, buf, NULL);
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
(Tcl_WideInt) (size_t) Tcl_GetChannelThread(chan)));
return TCL_OK;
}