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

Import Tcl-code 8.6.8

Browse Source
This commit is contained in:
Cheryl Sabella
2018-02-22 14:28:00 -05:00
parent 261a0e7c44
commit cc7c413b4f
509 changed files with 18473 additions and 18499 deletions
Download Patch File Download Diff File Expand all files Collapse all files

223
generic/tclBasic.c
View File

@@ -265,7 +265,6 @@ static const CmdInfo builtInCmds[] = {
{"cd", Tcl_CdObjCmd, NULL, NULL, 0},
{"close", Tcl_CloseObjCmd, NULL, NULL, CMD_IS_SAFE},
{"eof", Tcl_EofObjCmd, NULL, NULL, CMD_IS_SAFE},
{"encoding", Tcl_EncodingObjCmd, NULL, NULL, 0},
{"exec", Tcl_ExecObjCmd, NULL, NULL, 0},
{"exit", Tcl_ExitObjCmd, NULL, NULL, 0},
{"fblocked", Tcl_FblockedObjCmd, NULL, NULL, CMD_IS_SAFE},
@@ -789,16 +788,17 @@ Tcl_CreateInterp(void)
}
/*
* Create the "array", "binary", "chan", "dict", "file", "info",
* "namespace" and "string" ensembles. Note that all these commands (and
* their subcommands that are not present in the global namespace) are
* wholly safe *except* for "file".
* Create the "array", "binary", "chan", "clock", "dict", "encoding",
* "file", "info", "namespace" and "string" ensembles. Note that all these
* commands (and their subcommands that are not present in the global
* namespace) are wholly safe *except* for "clock", "encoding" and "file".
*/
TclInitArrayCmd(interp);
TclInitBinaryCmd(interp);
TclInitChanCmd(interp);
TclInitDictCmd(interp);
TclInitEncodingCmd(interp);
TclInitFileCmd(interp);
TclInitInfoCmd(interp);
TclInitNamespaceCmd(interp);
@@ -1026,6 +1026,7 @@ TclHideUnsafeCommands(
Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name);
}
}
TclMakeEncodingCommandSafe(interp); /* Ugh! */
TclMakeFileCommandSafe(interp); /* Ugh! */
return TCL_OK;
}
@@ -2041,11 +2042,11 @@ Tcl_CreateCommand(
{
Interp *iPtr = (Interp *) interp;
ImportRef *oldRefPtr = NULL;
Namespace *nsPtr, *dummy1, *dummy2;
Command *cmdPtr, *refCmdPtr;
Namespace *nsPtr;
Command *cmdPtr;
Tcl_HashEntry *hPtr;
const char *tail;
int isNew;
int isNew = 0, deleted = 0;
ImportedCmdData *dataPtr;
if (iPtr->flags & DELETED) {
@@ -2058,32 +2059,52 @@ Tcl_CreateCommand(
}
/*
* Determine where the command should reside. If its name contains
* namespace qualifiers, we put it in the specified namespace; otherwise,
* we always put it in the global namespace.
* If the command name we seek to create already exists, we need to
* delete that first. That can be tricky in the presence of traces.
* Loop until we no longer find an existing command in the way, or
* until we've deleted one command and that didn't finish the job.
*/
if (strstr(cmdName, "::") != NULL) {
TclGetNamespaceForQualName(interp, cmdName, NULL,
TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
if ((nsPtr == NULL) || (tail == NULL)) {
return (Tcl_Command) NULL;
}
} else {
nsPtr = iPtr->globalNsPtr;
tail = cmdName;
}
while (1) {
/*
* Determine where the command should reside. If its name contains
* namespace qualifiers, we put it in the specified namespace;
* otherwise, we always put it in the global namespace.
*/
if (strstr(cmdName, "::") != NULL) {
Namespace *dummy1, *dummy2;
TclGetNamespaceForQualName(interp, cmdName, NULL,
TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
if ((nsPtr == NULL) || (tail == NULL)) {
return (Tcl_Command) NULL;
}
} else {
nsPtr = iPtr->globalNsPtr;
tail = cmdName;
}
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
if (isNew || deleted) {
/*
* isNew - No conflict with existing command.
* deleted - We've already deleted a conflicting command
*/
break;
}
/* An existing command conflicts. Try to delete it.. */
cmdPtr = Tcl_GetHashValue(hPtr);
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
if (!isNew) {
/*
* Command already exists. Delete the old one. Be careful to preserve
* Be careful to preserve
* any existing import links so we can restore them down below. That
* way, you can redefine a command and its import status will remain
* intact.
*/
cmdPtr = Tcl_GetHashValue(hPtr);
cmdPtr->refCount++;
if (cmdPtr->importRefPtr) {
cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
@@ -2096,18 +2117,21 @@ Tcl_CreateCommand(
cmdPtr->importRefPtr = NULL;
}
TclCleanupCommandMacro(cmdPtr);
deleted = 1;
}
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
if (!isNew) {
/*
* If the deletion callback recreated the command, just throw away
* the new command (if we try to delete it again, we could get
* stuck in an infinite loop).
*/
if (!isNew) {
/*
* If the deletion callback recreated the command, just throw away
* the new command (if we try to delete it again, we could get
* stuck in an infinite loop).
*/
ckfree(Tcl_GetHashValue(hPtr));
}
if (!deleted) {
ckfree(Tcl_GetHashValue(hPtr));
}
} else {
/*
* Command resolvers (per-interp, per-namespace) might have resolved
* to a command for the given namespace scope with this command not
@@ -2155,7 +2179,7 @@ Tcl_CreateCommand(
if (oldRefPtr != NULL) {
cmdPtr->importRefPtr = oldRefPtr;
while (oldRefPtr != NULL) {
refCmdPtr = oldRefPtr->importedCmdPtr;
Command *refCmdPtr = oldRefPtr->importedCmdPtr;
dataPtr = refCmdPtr->objClientData;
dataPtr->realCmdPtr = cmdPtr;
oldRefPtr = oldRefPtr->nextPtr;
@@ -2216,11 +2240,11 @@ Tcl_CreateObjCommand(
{
Interp *iPtr = (Interp *) interp;
ImportRef *oldRefPtr = NULL;
Namespace *nsPtr, *dummy1, *dummy2;
Command *cmdPtr, *refCmdPtr;
Namespace *nsPtr;
Command *cmdPtr;
Tcl_HashEntry *hPtr;
const char *tail;
int isNew;
int isNew = 0, deleted = 0;
ImportedCmdData *dataPtr;
if (iPtr->flags & DELETED) {
@@ -2233,29 +2257,45 @@ Tcl_CreateObjCommand(
}
/*
* Determine where the command should reside. If its name contains
* namespace qualifiers, we put it in the specified namespace; otherwise,
* we always put it in the global namespace.
* If the command name we seek to create already exists, we need to
* delete that first. That can be tricky in the presence of traces.
* Loop until we no longer find an existing command in the way, or
* until we've deleted one command and that didn't finish the job.
*/
if (strstr(cmdName, "::") != NULL) {
TclGetNamespaceForQualName(interp, cmdName, NULL,
while (1) {
/*
* Determine where the command should reside. If its name contains
* namespace qualifiers, we put it in the specified namespace;
* otherwise, we always put it in the global namespace.
*/
if (strstr(cmdName, "::") != NULL) {
Namespace *dummy1, *dummy2;
TclGetNamespaceForQualName(interp, cmdName, NULL,
TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
if ((nsPtr == NULL) || (tail == NULL)) {
return (Tcl_Command) NULL;
}
} else {
nsPtr = iPtr->globalNsPtr;
tail = cmdName;
}
if ((nsPtr == NULL) || (tail == NULL)) {
return (Tcl_Command) NULL;
}
} else {
nsPtr = iPtr->globalNsPtr;
tail = cmdName;
}
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
TclInvalidateNsPath(nsPtr);
if (!isNew) {
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
if (isNew || deleted) {
/*
* isNew - No conflict with existing command.
* deleted - We've already deleted a conflicting command
*/
break;
}
/* An existing command conflicts. Try to delete it.. */
cmdPtr = Tcl_GetHashValue(hPtr);
/* Command already exists. */
/*
* [***] This is wrong. See Tcl Bug a16752c252.
* However, this buggy behavior is kept under particular
@@ -2292,18 +2332,20 @@ Tcl_CreateObjCommand(
cmdPtr->importRefPtr = NULL;
}
TclCleanupCommandMacro(cmdPtr);
deleted = 1;
}
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
if (!isNew) {
/*
* If the deletion callback recreated the command, just throw away
* the new command (if we try to delete it again, we could get
* stuck in an infinite loop).
*/
if (!isNew) {
/*
* If the deletion callback recreated the command, just throw away
* the new command (if we try to delete it again, we could get
* stuck in an infinite loop).
*/
ckfree(Tcl_GetHashValue(hPtr));
}
} else {
ckfree(Tcl_GetHashValue(hPtr));
}
if (!deleted) {
/*
* Command resolvers (per-interp, per-namespace) might have resolved
* to a command for the given namespace scope with this command not
@@ -2323,6 +2365,7 @@ Tcl_CreateObjCommand(
*/
TclInvalidateNsCmdLookup(nsPtr);
TclInvalidateNsPath(nsPtr);
}
cmdPtr = ckalloc(sizeof(Command));
Tcl_SetHashValue(hPtr, cmdPtr);
@@ -2350,7 +2393,7 @@ Tcl_CreateObjCommand(
if (oldRefPtr != NULL) {
cmdPtr->importRefPtr = oldRefPtr;
while (oldRefPtr != NULL) {
refCmdPtr = oldRefPtr->importedCmdPtr;
Command *refCmdPtr = oldRefPtr->importedCmdPtr;
dataPtr = refCmdPtr->objClientData;
dataPtr->realCmdPtr = cmdPtr;
oldRefPtr = oldRefPtr->nextPtr;
@@ -3069,6 +3112,7 @@ Tcl_DeleteCommandFromToken(
* traces.
*/
cmdPtr->nsPtr->refCount++;
if (cmdPtr->tracePtr != NULL) {
CommandTrace *tracePtr;
CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE);
@@ -3096,6 +3140,7 @@ Tcl_DeleteCommandFromToken(
*/
TclInvalidateNsCmdLookup(cmdPtr->nsPtr);
TclNsDecrRefCount(cmdPtr->nsPtr);
/*
* If the command being deleted has a compile function, increment the
@@ -3542,7 +3587,7 @@ OldMathFuncProc(
args[k].type = TCL_INT;
break;
}
if (Tcl_GetWideIntFromObj(interp, valuePtr, &args[k].wideValue)
if (TclGetWideIntFromObj(interp, valuePtr, &args[k].wideValue)
== TCL_OK) {
args[k].type = TCL_WIDE_INT;
break;
@@ -3568,7 +3613,7 @@ OldMathFuncProc(
return TCL_ERROR;
}
valuePtr = Tcl_GetObjResult(interp);
Tcl_GetWideIntFromObj(NULL, valuePtr, &args[k].wideValue);
TclGetWideIntFromObj(NULL, valuePtr, &args[k].wideValue);
Tcl_ResetResult(interp);
break;
}
@@ -4516,7 +4561,7 @@ TEOV_Exception(
if (result == TCL_RETURN) {
result = TclUpdateReturnInfo(iPtr);
}
if ((result != TCL_ERROR) && !allowExceptions) {
if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) {
ProcessUnexpectedResult(interp, result);
result = TCL_ERROR;
}
@@ -7173,7 +7218,7 @@ ExprIsqrtFunc(
}
break;
default:
if (Tcl_GetWideIntFromObj(interp, objv[1], &w) != TCL_OK) {
if (TclGetWideIntFromObj(interp, objv[1], &w) != TCL_OK) {
return TCL_ERROR;
}
if (w < 0) {
@@ -7616,7 +7661,7 @@ ExprWideFunc(
return TCL_ERROR;
}
objPtr = Tcl_GetObjResult(interp);
if (Tcl_GetWideIntFromObj(NULL, objPtr, &wResult) != TCL_OK) {
if (TclGetWideIntFromObj(NULL, objPtr, &wResult) != TCL_OK) {
/*
* Truncate the bignum; keep only bits in wide int range.
*/
@@ -7627,7 +7672,7 @@ ExprWideFunc(
mp_mod_2d(&big, (int) CHAR_BIT * sizeof(Tcl_WideInt), &big);
objPtr = Tcl_NewBignumObj(&big);
Tcl_IncrRefCount(objPtr);
Tcl_GetWideIntFromObj(NULL, objPtr, &wResult);
TclGetWideIntFromObj(NULL, objPtr, &wResult);
Tcl_DecrRefCount(objPtr);
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(wResult));
@@ -8744,6 +8789,35 @@ TclNRCoroutineActivateCallback(
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TclNREvalList --
*
* Callback to invoke command as list, used in order to delayed
* processing of canonical list command in sane environment.
*
*----------------------------------------------------------------------
*/
static int
TclNREvalList(
ClientData data[],
Tcl_Interp *interp,
int result)
{
int objc;
Tcl_Obj **objv;
Tcl_Obj *listPtr = data[0];
Tcl_IncrRefCount(listPtr);
TclMarkTailcall(interp);
TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL);
TclListObjGetElements(NULL, listPtr, &objc, &objv);
return TclNREvalObjv(interp, objc, objv, 0, NULL);
}
/*
*----------------------------------------------------------------------
*
@@ -8798,7 +8872,8 @@ NRCoroInjectObjCmd(
*/
iPtr->execEnvPtr = corPtr->eePtr;
TclNREvalObjEx(interp, Tcl_NewListObj(objc-2, objv+2), 0, NULL, INT_MIN);
TclNRAddCallback(interp, TclNREvalList, Tcl_NewListObj(objc-2, objv+2),
NULL, NULL, NULL);
iPtr->execEnvPtr = savedEEPtr;
return TCL_OK;