Import Tcl 8.6.10

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

View File

@@ -41,6 +41,8 @@ static int TestwinclockCmd(ClientData dummy, Tcl_Interp* interp,
int objc, Tcl_Obj *const objv[]);
static int TestwinsleepCmd(ClientData dummy, Tcl_Interp* interp,
int objc, Tcl_Obj *const objv[]);
static int TestSizeCmd(ClientData dummy, Tcl_Interp* interp,
int objc, Tcl_Obj *const objv[]);
static Tcl_ObjCmdProc TestExceptionCmd;
static int TestplatformChmod(const char *nativePath, int pmode);
static int TestchmodCmd(ClientData dummy, Tcl_Interp* interp,
@@ -78,6 +80,7 @@ TclplatformtestInit(
Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testsize", TestSizeCmd, NULL, NULL);
return TCL_OK;
}
@@ -136,7 +139,7 @@ TesteventloopCmd(
while (!done) {
MSG msg;
if (!GetMessage(&msg, NULL, 0, 0)) {
if (!GetMessageW(&msg, NULL, 0, 0)) {
/*
* The application is exiting, so repost the quit message and
* start unwinding.
@@ -146,7 +149,7 @@ TesteventloopCmd(
break;
}
TranslateMessage(&msg);
DispatchMessage(&msg);
DispatchMessageW(&msg);
}
(void) Tcl_SetServiceMode(oldMode);
framePtr = oldFramePtr;
@@ -310,6 +313,31 @@ TestwinsleepCmd(
return TCL_OK;
}
static int
TestSizeCmd(
ClientData clientData, /* Unused */
Tcl_Interp* interp, /* Tcl interpreter */
int objc, /* Parameter count */
Tcl_Obj *const * objv) /* Parameter vector */
{
if (objc != 2) {
goto syntax;
}
if (strcmp(Tcl_GetString(objv[1]), "time_t") == 0) {
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(sizeof(time_t)));
return TCL_OK;
}
if (strcmp(Tcl_GetString(objv[1]), "st_mtime") == 0) {
Tcl_StatBuf *statPtr;
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(sizeof(statPtr->st_mtime)));
return TCL_OK;
}
syntax:
Tcl_WrongNumArgs(interp, 1, objv, "time_t|st_mtime");
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
@@ -399,9 +427,11 @@ TestplatformChmod(
{
static const SECURITY_INFORMATION infoBits = OWNER_SECURITY_INFORMATION
| GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION;
/* don't reset change permissions mask (WRITE_DAC, allow test-cases restore it to cleanup) */
static const DWORD readOnlyMask = FILE_DELETE_CHILD | FILE_ADD_FILE
| FILE_ADD_SUBDIRECTORY | FILE_WRITE_EA | FILE_APPEND_DATA
| FILE_WRITE_DATA | DELETE;
| FILE_WRITE_DATA
| DELETE;
/*
* References to security functions (only available on NT and later).
@@ -565,11 +595,13 @@ TestplatformChmod(
}
/*
* Apply the new ACL.
* Apply the new ACL. Note PROTECTED_DACL_SECURITY_INFORMATION can be used
* to remove inherited ACL (we need to overwrite the default ACL's in this case)
*/
if (set_readOnly == acl_readOnly_found || SetNamedSecurityInfoA(
(LPSTR) nativePath, SE_FILE_OBJECT, DACL_SECURITY_INFORMATION,
(LPSTR) nativePath, SE_FILE_OBJECT,
DACL_SECURITY_INFORMATION /*| PROTECTED_DACL_SECURITY_INFORMATION*/,
NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) {
res = 0;
}