From 20bd9d9cabc9db212abbaf9d4dbb18eb490e9f71 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 17 Jul 2019 15:38:17 +0000 Subject: Eliminate "register" keyword _everywhere_ in Tcl. This keyword is deprecated in C++ (removed in C++17, even), and essentially does nothing with most modern compilers. --- compat/mkstemp.c | 2 +- compat/opendir.c | 10 +-- compat/strstr.c | 4 +- compat/strtol.c | 2 +- compat/strtoul.c | 6 +- compat/waitpid.c | 2 +- generic/regcomp.c | 2 +- generic/regcustom.h | 4 +- generic/regguts.h | 2 +- generic/tclAlloc.c | 18 ++--- generic/tclAssembly.c | 2 +- generic/tclBasic.c | 44 +++++------ generic/tclBinary.c | 8 +- generic/tclCmdAH.c | 10 +-- generic/tclCmdIL.c | 28 +++---- generic/tclCmdMZ.c | 14 ++-- generic/tclCompCmds.c | 30 ++++---- generic/tclCompCmdsSZ.c | 8 +- generic/tclCompile.c | 60 +++++++-------- generic/tclCompile.h | 4 +- generic/tclDate.c | 10 +-- generic/tclDisassemble.c | 6 +- generic/tclEnsemble.c | 6 +- generic/tclExecute.c | 34 ++++----- generic/tclFileName.c | 6 +- generic/tclGetDate.y | 10 +-- generic/tclHash.c | 42 +++++------ generic/tclHistory.c | 4 +- generic/tclIO.c | 6 +- generic/tclIORChan.c | 2 +- generic/tclIORTrans.c | 2 +- generic/tclIndexObj.c | 14 ++-- generic/tclInt.h | 5 +- generic/tclInterp.c | 8 +- generic/tclListObj.c | 22 +++--- generic/tclLiteral.c | 44 +++++------ generic/tclNamesp.c | 70 +++++++++--------- generic/tclOO.c | 12 +-- generic/tclOOBasic.c | 4 +- generic/tclOOCall.c | 10 +-- generic/tclOODefineCmds.c | 2 +- generic/tclOOInt.h | 2 +- generic/tclOOMethod.c | 24 +++--- generic/tclObj.c | 182 +++++++++++++++++++++++----------------------- generic/tclParse.c | 44 +++++------ generic/tclPathObj.c | 2 +- generic/tclPipe.c | 4 +- generic/tclProc.c | 48 ++++++------ generic/tclResult.c | 26 +++---- generic/tclTest.c | 12 +-- generic/tclTestObj.c | 4 +- generic/tclThreadAlloc.c | 22 +++--- generic/tclTimer.c | 10 +-- generic/tclTrace.c | 36 ++++----- generic/tclUtf.c | 20 ++--- generic/tclUtil.c | 16 ++-- generic/tclVar.c | 54 +++++++------- macosx/tclMacOSXFCmd.c | 2 +- unix/tclLoadAix.c | 20 ++--- unix/tclUnixCompat.c | 4 +- unix/tclUnixInit.c | 2 +- unix/tclUnixThrd.c | 2 +- win/tclWinInit.c | 2 +- 63 files changed, 559 insertions(+), 558 deletions(-) diff --git a/compat/mkstemp.c b/compat/mkstemp.c index 1a44dfa..6807414 100644 --- a/compat/mkstemp.c +++ b/compat/mkstemp.c @@ -36,7 +36,7 @@ mkstemp( { static const char alphanumerics[] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"; - register char *a, *b; + char *a, *b; int fd, count, alphanumericsLen = strlen(alphanumerics); /* == 62 */ a = template + strlen(template); diff --git a/compat/opendir.c b/compat/opendir.c index 7a49566..ea6831b 100644 --- a/compat/opendir.c +++ b/compat/opendir.c @@ -20,8 +20,8 @@ DIR * opendir( char *name) { - register DIR *dirp; - register int fd; + DIR *dirp; + int fd; char *myname; myname = ((*name == '\0') ? "." : name); @@ -65,9 +65,9 @@ struct olddirect { struct dirent * readdir( - register DIR *dirp) + DIR *dirp) { - register struct olddirect *dp; + struct olddirect *dp; static struct dirent dir; for (;;) { @@ -101,7 +101,7 @@ readdir( void closedir( - register DIR *dirp) + DIR *dirp) { close(dirp->dd_fd); dirp->dd_fd = -1; diff --git a/compat/strstr.c b/compat/strstr.c index e3b9b8d..7f7438e 100644 --- a/compat/strstr.c +++ b/compat/strstr.c @@ -36,10 +36,10 @@ char * strstr( - register char *string, /* String to search. */ + char *string, /* String to search. */ char *substring) /* Substring to try to find in string. */ { - register char *a, *b; + char *a, *b; /* * First scan quickly through the two strings looking for a diff --git a/compat/strtol.c b/compat/strtol.c index b7f6919..22cc1eb 100644 --- a/compat/strtol.c +++ b/compat/strtol.c @@ -45,7 +45,7 @@ strtol( * hex, "0" means octal, anything else means * decimal. */ { - register const char *p; + const char *p; long result; /* diff --git a/compat/strtoul.c b/compat/strtoul.c index e37eb05..bf16f7a 100644 --- a/compat/strtoul.c +++ b/compat/strtoul.c @@ -62,9 +62,9 @@ strtoul( * hex, "0" means octal, anything else means * decimal. */ { - register const char *p; - register unsigned long int result = 0; - register unsigned digit; + const char *p; + unsigned long int result = 0; + unsigned digit; int anyDigits = 0; int negative=0; int overflow=0; diff --git a/compat/waitpid.c b/compat/waitpid.c index d4473a8..626d210 100644 --- a/compat/waitpid.c +++ b/compat/waitpid.c @@ -70,7 +70,7 @@ waitpid( int options) /* OR'ed combination of WNOHANG and * WUNTRACED. */ { - register WaitInfo *waitPtr, *prevPtr; + WaitInfo *waitPtr, *prevPtr; pid_t result; WAIT_STATUS_TYPE status; diff --git a/generic/regcomp.c b/generic/regcomp.c index 49b024f..093cb95 100644 --- a/generic/regcomp.c +++ b/generic/regcomp.c @@ -512,7 +512,7 @@ freev( struct vars *v, int err) { - register int ret; + int ret; if (v->re != NULL) { rfree(v->re); diff --git a/generic/regcustom.h b/generic/regcustom.h index 095385d..4396399 100644 --- a/generic/regcustom.h +++ b/generic/regcustom.h @@ -131,7 +131,7 @@ typedef int celt; /* Type to hold chr, or NOCELT */ #if 1 #define AllocVars(vPtr) \ static Tcl_ThreadDataKey varsKey; \ - register struct vars *vPtr = (struct vars *) \ + struct vars *vPtr = (struct vars *) \ Tcl_GetThreadData(&varsKey, sizeof(struct vars)) #else /* @@ -140,7 +140,7 @@ typedef int celt; /* Type to hold chr, or NOCELT */ * faster in practice (measured!) */ #define AllocVars(vPtr) \ - register struct vars *vPtr = (struct vars *) MALLOC(sizeof(struct vars)) + struct vars *vPtr = (struct vars *) MALLOC(sizeof(struct vars)) #define FreeVars(vPtr) \ FREE(vPtr) #endif diff --git a/generic/regguts.h b/generic/regguts.h index b3dbaa4..da38ef2 100644 --- a/generic/regguts.h +++ b/generic/regguts.h @@ -411,7 +411,7 @@ struct guts { #ifndef AllocVars #define AllocVars(vPtr) \ struct vars var; \ - register struct vars *vPtr = &var + struct vars *vPtr = &var #endif #ifndef FreeVars #define FreeVars(vPtr) ((void) 0) diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c index bad3d8a..669c186 100644 --- a/generic/tclAlloc.c +++ b/generic/tclAlloc.c @@ -253,9 +253,9 @@ char * TclpAlloc( unsigned int numBytes) /* Number of bytes to allocate. */ { - register union overhead *overPtr; - register size_t bucket; - register unsigned amount; + union overhead *overPtr; + size_t bucket; + unsigned amount; struct block *bigBlockPtr = NULL; if (!allocInit) { @@ -387,8 +387,8 @@ static void MoreCore( size_t bucket) /* What bucket to allocate to. */ { - register union overhead *overPtr; - register size_t size; /* size of desired block */ + union overhead *overPtr; + size_t size; /* size of desired block */ size_t amount; /* amount to allocate */ size_t numBlocks; /* how many blocks we get */ struct block *blockPtr; @@ -448,8 +448,8 @@ void TclpFree( char *oldPtr) /* Pointer to memory to free. */ { - register size_t size; - register union overhead *overPtr; + size_t size; + union overhead *overPtr; struct block *bigBlockPtr; if (oldPtr == NULL) { @@ -645,8 +645,8 @@ void mstats( char *s) /* Where to write info. */ { - register unsigned int i, j; - register union overhead *overPtr; + unsigned int i, j; + union overhead *overPtr; size_t totalFree = 0, totalUsed = 0; Tcl_MutexLock(allocMutexPtr); diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index e8ca9ca..8e2edcf 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -853,7 +853,7 @@ CompileAssembleObj( Interp *iPtr = (Interp *) interp; /* Internals of the interpreter */ CompileEnv compEnv; /* Compilation environment structure */ - register ByteCode *codePtr = NULL; + ByteCode *codePtr = NULL; /* Bytecode resulting from the assembly */ Namespace* namespacePtr; /* Namespace in which variable and command * names in the bytecode resolve */ diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 78b9f0c..0f11f04 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -1305,8 +1305,8 @@ int TclHideUnsafeCommands( Tcl_Interp *interp) /* Hide commands in this interpreter. */ { - register const CmdInfo *cmdInfoPtr; - register const UnsafeEnsembleInfo *unsafePtr; + const CmdInfo *cmdInfoPtr; + const UnsafeEnsembleInfo *unsafePtr; if (interp == NULL) { return TCL_ERROR; @@ -2832,7 +2832,7 @@ int TclInvokeStringCommand( ClientData clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ - register int objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Command *cmdPtr = clientData; @@ -2881,7 +2881,7 @@ TclInvokeObjectCommand( ClientData clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ - register const char **argv) /* Argument strings. */ + const char **argv) /* Argument strings. */ { Command *cmdPtr = clientData; Tcl_Obj *objPtr; @@ -3372,7 +3372,7 @@ Tcl_GetCommandFullName( { Interp *iPtr = (Interp *) interp; - register Command *cmdPtr = (Command *) command; + Command *cmdPtr = (Command *) command; char *name; /* @@ -3656,7 +3656,7 @@ CallCommandTraces( * trigger, either TCL_TRACE_DELETE or * TCL_TRACE_RENAME. */ { - register CommandTrace *tracePtr; + CommandTrace *tracePtr; ActiveCommandTrace active; char *result; Tcl_Obj *oldNamePtr = NULL; @@ -3846,7 +3846,7 @@ CancelEvalProc( void TclCleanupCommand( - register Command *cmdPtr) /* Points to the Command structure to + Command *cmdPtr) /* Points to the Command structure to * be freed. */ { if (cmdPtr->refCount-- <= 1) { @@ -4237,7 +4237,7 @@ int TclInterpReady( Tcl_Interp *interp) { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; /* * Reset both the interpreter's string and object results and clear out @@ -4309,7 +4309,7 @@ TclResetCancellation( Tcl_Interp *interp, int force) { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; if (iPtr == NULL) { return TCL_ERROR; @@ -4351,7 +4351,7 @@ Tcl_Canceled( Tcl_Interp *interp, int flags) { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; /* * Has the current script in progress for this interpreter been canceled @@ -5872,7 +5872,7 @@ TclAdvanceLines( const char *start, const char *end) { - register const char *p; + const char *p; for (p = start; p < end; p++) { if (*p == '\n') { @@ -6398,7 +6398,7 @@ int Tcl_EvalObjEx( Tcl_Interp *interp, /* Token for command interpreter (returned by * a previous call to Tcl_CreateInterp). */ - register Tcl_Obj *objPtr, /* Pointer to object containing commands to + Tcl_Obj *objPtr, /* Pointer to object containing commands to * execute. */ int flags) /* Collection of OR-ed bits that control the * evaluation of the script. Supported values @@ -6411,7 +6411,7 @@ int TclEvalObjEx( Tcl_Interp *interp, /* Token for command interpreter (returned by * a previous call to Tcl_CreateInterp). */ - register Tcl_Obj *objPtr, /* Pointer to object containing commands to + Tcl_Obj *objPtr, /* Pointer to object containing commands to * execute. */ int flags, /* Collection of OR-ed bits that control the * evaluation of the script. Supported values @@ -6430,7 +6430,7 @@ int TclNREvalObjEx( Tcl_Interp *interp, /* Token for command interpreter (returned by * a previous call to Tcl_CreateInterp). */ - register Tcl_Obj *objPtr, /* Pointer to object containing commands to + Tcl_Obj *objPtr, /* Pointer to object containing commands to * execute. */ int flags, /* Collection of OR-ed bits that control the * evaluation of the script. Supported values @@ -6738,7 +6738,7 @@ Tcl_ExprLong( const char *exprstring, /* Expression to evaluate. */ long *ptr) /* Where to store result. */ { - register Tcl_Obj *exprPtr; + Tcl_Obj *exprPtr; int result = TCL_OK; if (*exprstring == '\0') { /* @@ -6765,7 +6765,7 @@ Tcl_ExprDouble( const char *exprstring, /* Expression to evaluate. */ double *ptr) /* Where to store result. */ { - register Tcl_Obj *exprPtr; + Tcl_Obj *exprPtr; int result = TCL_OK; if (*exprstring == '\0') { @@ -6845,7 +6845,7 @@ int Tcl_ExprLongObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ - register Tcl_Obj *objPtr, /* Expression to evaluate. */ + Tcl_Obj *objPtr, /* Expression to evaluate. */ long *ptr) /* Where to store long result. */ { Tcl_Obj *resultPtr; @@ -6892,7 +6892,7 @@ int Tcl_ExprDoubleObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ - register Tcl_Obj *objPtr, /* Expression to evaluate. */ + Tcl_Obj *objPtr, /* Expression to evaluate. */ double *ptr) /* Where to store double result. */ { Tcl_Obj *resultPtr; @@ -6928,7 +6928,7 @@ int Tcl_ExprBooleanObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ - register Tcl_Obj *objPtr, /* Expression to evaluate. */ + Tcl_Obj *objPtr, /* Expression to evaluate. */ int *ptr) /* Where to store 0/1 result. */ { Tcl_Obj *resultPtr; @@ -7040,7 +7040,7 @@ TclNRInvoke( int objc, Tcl_Obj *const objv[]) { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; Tcl_HashTable *hTblPtr; /* Table of hidden commands. */ const char *cmdName; /* Name of the command from objv[0]. */ Tcl_HashEntry *hPtr = NULL; @@ -7235,7 +7235,7 @@ Tcl_AddObjErrorInfo( int length) /* The number of bytes in the message. If < 0, * then append all bytes up to a NULL byte. */ { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; /* * If we are just starting to log an error, errorInfo is initialized from @@ -7385,7 +7385,7 @@ Tcl_GlobalEval( * command. */ const char *command) /* Command to evaluate. */ { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; int result; CallFrame *savedVarFramePtr; diff --git a/generic/tclBinary.c b/generic/tclBinary.c index d8b9ae9..027c157 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -2288,8 +2288,8 @@ ScanNumber( if (*numberCachePtrPtr == NULL) { return Tcl_NewWideIntObj(value); } else { - register Tcl_HashTable *tablePtr = *numberCachePtrPtr; - register Tcl_HashEntry *hPtr; + Tcl_HashTable *tablePtr = *numberCachePtrPtr; + Tcl_HashEntry *hPtr; int isNew; hPtr = Tcl_CreateHashEntry(tablePtr, INT2PTR(value), &isNew); @@ -2297,7 +2297,7 @@ ScanNumber( return Tcl_GetHashValue(hPtr); } if (tablePtr->numEntries <= BINARY_SCAN_MAX_CACHE) { - register Tcl_Obj *objPtr = Tcl_NewWideIntObj(value); + Tcl_Obj *objPtr = Tcl_NewWideIntObj(value); Tcl_IncrRefCount(objPtr); Tcl_SetHashValue(hPtr, objPtr); @@ -2416,7 +2416,7 @@ DeleteScanNumberCache( hEntry = Tcl_FirstHashEntry(numberCachePtr, &search); while (hEntry != NULL) { - register Tcl_Obj *value = Tcl_GetHashValue(hEntry); + Tcl_Obj *value = Tcl_GetHashValue(hEntry); if (value != NULL) { Tcl_DecrRefCount(value); diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index dff23a8..deec6ba 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -169,7 +169,7 @@ Tcl_CaseObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - register int i; + int i; int body, result, caseObjc; const char *stringPtr, *arg; Tcl_Obj *const *caseObjv; @@ -872,7 +872,7 @@ TclNREvalObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - register Tcl_Obj *objPtr; + Tcl_Obj *objPtr; Interp *iPtr = (Interp *) interp; CmdFrame *invoker = NULL; int word = 0; @@ -2254,7 +2254,7 @@ StoreStatData( * store in varName. */ { Tcl_Obj *field, *value; - register unsigned short mode; + unsigned short mode; /* * Assume Tcl_ObjSetVar2() does not keep a copy of the field name! @@ -2631,7 +2631,7 @@ EachloopCmd( Tcl_Obj *const objv[]) { int numLists = (objc-2) / 2; - register struct ForeachState *statePtr; + struct ForeachState *statePtr; int i, j, result; if (objc < 4 || (objc%2 != 0)) { @@ -2756,7 +2756,7 @@ ForeachLoopStep( Tcl_Interp *interp, int result) { - register struct ForeachState *statePtr = data[0]; + struct ForeachState *statePtr = data[0]; /* * Process the result code from this run of the [foreach] body. Note that diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index cbb40c6..9d4bbf3 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -475,7 +475,7 @@ InfoArgsCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; const char *name; Proc *procPtr; CompiledLocal *localPtr; @@ -538,7 +538,7 @@ InfoBodyCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; const char *name, *bytes; Proc *procPtr; int numBytes; @@ -643,7 +643,7 @@ InfoCommandsCmd( { const char *cmdName, *pattern; const char *simplePattern; - register Tcl_HashEntry *entryPtr; + Tcl_HashEntry *entryPtr; Tcl_HashSearch search; Namespace *nsPtr; Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); @@ -1843,7 +1843,7 @@ InfoProcsCmd( Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); Tcl_Obj *listPtr, *elemObjPtr; int specificNsInPattern = 0;/* Init. to avoid compiler warning. */ - register Tcl_HashEntry *entryPtr; + Tcl_HashEntry *entryPtr; Tcl_HashSearch search; Command *cmdPtr, *realCmdPtr; @@ -2415,7 +2415,7 @@ int Tcl_LinsertObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - register int objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *listPtr; @@ -2497,8 +2497,8 @@ int Tcl_ListObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - register int objc, /* Number of arguments. */ - register Tcl_Obj *const objv[]) + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* The argument objects. */ { /* @@ -2534,7 +2534,7 @@ Tcl_LlengthObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - register Tcl_Obj *const objv[]) + Tcl_Obj *const objv[]) /* Argument objects. */ { int listLen, result; @@ -2580,7 +2580,7 @@ Tcl_LpopObjCmd( ClientData notUsed, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - register Tcl_Obj *const objv[]) + Tcl_Obj *const objv[]) /* Argument objects. */ { int listLen, result; @@ -2673,7 +2673,7 @@ Tcl_LrangeObjCmd( ClientData notUsed, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - register Tcl_Obj *const objv[]) + Tcl_Obj *const objv[]) /* Argument objects. */ { int listLen, first, last, result; @@ -2859,8 +2859,8 @@ int Tcl_LrepeatObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - register int objc, /* Number of arguments. */ - register Tcl_Obj *const objv[]) + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* The argument objects. */ { int elementCount, i, totalElems; @@ -2925,7 +2925,7 @@ Tcl_LrepeatObjCmd( CLANG_ASSERT(dataArray || totalElems == 0 ); if (objc == 1) { - register Tcl_Obj *tmpPtr = objv[0]; + Tcl_Obj *tmpPtr = objv[0]; tmpPtr->refCount += elementCount; for (i=0 ; inumLists; dupPtr = ckalloc(sizeof(ForeachInfo) @@ -2961,10 +2961,10 @@ FreeForeachInfo( ClientData clientData) /* The foreach command's compilation auxiliary * data to free. */ { - register ForeachInfo *infoPtr = clientData; - register ForeachVarList *listPtr; + ForeachInfo *infoPtr = clientData; + ForeachVarList *listPtr; int numLists = infoPtr->numLists; - register int i; + int i; for (i = 0; i < numLists; i++) { listPtr = infoPtr->varLists[i]; @@ -2997,8 +2997,8 @@ PrintForeachInfo( ByteCode *codePtr, unsigned int pcOffset) { - register ForeachInfo *infoPtr = clientData; - register ForeachVarList *varsPtr; + ForeachInfo *infoPtr = clientData; + ForeachVarList *varsPtr; int i, j; Tcl_AppendToObj(appendObj, "data=[", -1); @@ -3037,8 +3037,8 @@ PrintNewForeachInfo( ByteCode *codePtr, unsigned int pcOffset) { - register ForeachInfo *infoPtr = clientData; - register ForeachVarList *varsPtr; + ForeachInfo *infoPtr = clientData; + ForeachVarList *varsPtr; int i, j; Tcl_AppendPrintfToObj(appendObj, "jumpOffset=%+d, vars=", @@ -3067,8 +3067,8 @@ DisassembleForeachInfo( ByteCode *codePtr, unsigned int pcOffset) { - register ForeachInfo *infoPtr = clientData; - register ForeachVarList *varsPtr; + ForeachInfo *infoPtr = clientData; + ForeachVarList *varsPtr; int i, j; Tcl_Obj *objPtr, *innerPtr; @@ -3114,8 +3114,8 @@ DisassembleNewForeachInfo( ByteCode *codePtr, unsigned int pcOffset) { - register ForeachInfo *infoPtr = clientData; - register ForeachVarList *varsPtr; + ForeachInfo *infoPtr = clientData; + ForeachVarList *varsPtr; int i, j; Tcl_Obj *objPtr, *innerPtr; @@ -3439,9 +3439,9 @@ TclPushVarName( int *localIndexPtr, /* Must not be NULL. */ int *isScalarPtr) /* Must not be NULL. */ { - register const char *p; + const char *p; const char *last, *name, *elName; - register int n; + int n; Tcl_Token *elemTokenPtr = NULL; int nameLen, elNameLen, simpleVarName, localIndex; int elemTokenCount = 0, allocedTokens = 0, removedParen = 0; diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index da45cb3..bfae433 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -1862,8 +1862,8 @@ TclCompileSwitchCmd( */ for (; numWords>=3 ; tokenPtr=TokenAfter(tokenPtr),numWords--) { - register unsigned size = tokenPtr[1].size; - register const char *chrs = tokenPtr[1].start; + unsigned size = tokenPtr[1].size; + const char *chrs = tokenPtr[1].start; /* * We only process literal options, and we assume that -e, -g and -n @@ -2602,7 +2602,7 @@ PrintJumptableInfo( ByteCode *codePtr, unsigned int pcOffset) { - register JumptableInfo *jtPtr = clientData; + JumptableInfo *jtPtr = clientData; Tcl_HashEntry *hPtr; Tcl_HashSearch search; const char *keyPtr; @@ -2631,7 +2631,7 @@ DisassembleJumptableInfo( ByteCode *codePtr, unsigned int pcOffset) { - register JumptableInfo *jtPtr = clientData; + JumptableInfo *jtPtr = clientData; Tcl_Obj *mapping = Tcl_NewObj(); Tcl_HashEntry *hPtr; Tcl_HashSearch search; diff --git a/generic/tclCompile.c b/generic/tclCompile.c index c10e3ee..8a13eba 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -990,7 +990,7 @@ DupByteCodeInternalRep( static void FreeByteCodeInternalRep( - register Tcl_Obj *objPtr) /* Object whose internal rep to free. */ + Tcl_Obj *objPtr) /* Object whose internal rep to free. */ { ByteCode *codePtr; @@ -1021,14 +1021,14 @@ FreeByteCodeInternalRep( void TclPreserveByteCode( - register ByteCode *codePtr) + ByteCode *codePtr) { codePtr->refCount++; } void TclReleaseByteCode( - register ByteCode *codePtr) + ByteCode *codePtr) { if (codePtr->refCount-- > 1) { return; @@ -1040,14 +1040,14 @@ TclReleaseByteCode( static void CleanupByteCode( - register ByteCode *codePtr) /* Points to the ByteCode to free. */ + ByteCode *codePtr) /* Points to the ByteCode to free. */ { Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle; Interp *iPtr = (Interp *) interp; int numLitObjects = codePtr->numLitObjects; int numAuxDataItems = codePtr->numAuxDataItems; - register Tcl_Obj **objArrayPtr, *objPtr; - register const AuxData *auxDataPtr; + Tcl_Obj **objArrayPtr, *objPtr; + const AuxData *auxDataPtr; int i; #ifdef TCL_COMPILE_STATS @@ -1392,9 +1392,9 @@ CompileSubstObj( static void FreeSubstCodeInternalRep( - register Tcl_Obj *objPtr) /* Object whose internal rep to free. */ + Tcl_Obj *objPtr) /* Object whose internal rep to free. */ { - register ByteCode *codePtr; + ByteCode *codePtr; ByteCodeGetIntRep(objPtr, &substCodeType, codePtr); assert(codePtr != NULL); @@ -1443,7 +1443,7 @@ void TclInitCompileEnv( Tcl_Interp *interp, /* The interpreter for which a CompileEnv * structure is initialized. */ - register CompileEnv *envPtr,/* Points to the CompileEnv structure to + CompileEnv *envPtr,/* Points to the CompileEnv structure to * initialize. */ const char *stringPtr, /* The source string to be compiled. */ int numBytes, /* Number of bytes in source string. */ @@ -1650,7 +1650,7 @@ TclInitCompileEnv( void TclFreeCompileEnv( - register CompileEnv *envPtr)/* Points to the CompileEnv structure. */ + CompileEnv *envPtr)/* Points to the CompileEnv structure. */ { if (envPtr->localLitTable.buckets != envPtr->localLitTable.staticBuckets){ ckfree(envPtr->localLitTable.buckets); @@ -2782,13 +2782,13 @@ PreventCycle( ByteCode * TclInitByteCode( - register CompileEnv *envPtr)/* Points to the CompileEnv structure from + CompileEnv *envPtr)/* Points to the CompileEnv structure from * which to create a ByteCode structure. */ { - register ByteCode *codePtr; + ByteCode *codePtr; size_t codeBytes, objArrayBytes, exceptArrayBytes, cmdLocBytes; size_t auxDataArrayBytes, structureSize; - register unsigned char *p; + unsigned char *p; #ifdef TCL_COMPILE_DEBUG unsigned char *nextPtr; #endif @@ -2923,7 +2923,7 @@ TclInitByteCodeObj( * and whose string rep contains the source * code. */ const Tcl_ObjType *typePtr, - register CompileEnv *envPtr)/* Points to the CompileEnv structure from + CompileEnv *envPtr)/* Points to the CompileEnv structure from * which to create a ByteCode structure. */ { ByteCode *codePtr; @@ -2968,7 +2968,7 @@ TclInitByteCodeObj( int TclFindCompiledLocal( - register const char *name, /* Points to first character of the name of a + const char *name, /* Points to first character of the name of a * scalar or array variable. If NULL, a * temporary var should be created. */ int nameBytes, /* Number of bytes in the name. */ @@ -2976,9 +2976,9 @@ TclFindCompiledLocal( * variable if it is new. */ CompileEnv *envPtr) /* Points to the current compile environment*/ { - register CompiledLocal *localPtr; + CompiledLocal *localPtr; int localVar = -1; - register int i; + int i; Proc *procPtr; /* @@ -3351,11 +3351,11 @@ EnterCmdWordData( int TclCreateExceptRange( ExceptionRangeType type, /* The kind of ExceptionRange desired. */ - register CompileEnv *envPtr)/* Points to CompileEnv for which to create a + CompileEnv *envPtr)/* Points to CompileEnv for which to create a * new ExceptionRange structure. */ { - register ExceptionRange *rangePtr; - register ExceptionAux *auxPtr; + ExceptionRange *rangePtr; + ExceptionAux *auxPtr; int index = envPtr->exceptArrayNext; if (index >= envPtr->exceptArrayEnd) { @@ -3719,11 +3719,11 @@ TclCreateAuxData( * the new aux data record. */ const AuxDataType *typePtr, /* Pointer to the type to attach to this * AuxData */ - register CompileEnv *envPtr)/* Points to the CompileEnv for which a new + CompileEnv *envPtr)/* Points to the CompileEnv for which a new * aux data structure is to be allocated. */ { int index; /* Index for the new AuxData structure. */ - register AuxData *auxDataPtr; + AuxData *auxDataPtr; /* Points to the new AuxData structure */ index = envPtr->auxDataArrayNext; @@ -3782,7 +3782,7 @@ TclCreateAuxData( void TclInitJumpFixupArray( - register JumpFixupArray *fixupArrayPtr) + JumpFixupArray *fixupArrayPtr) /* Points to the JumpFixupArray structure to * initialize. */ { @@ -3814,7 +3814,7 @@ TclInitJumpFixupArray( void TclExpandJumpFixupArray( - register JumpFixupArray *fixupArrayPtr) + JumpFixupArray *fixupArrayPtr) /* Points to the JumpFixupArray structure to * enlarge. */ { @@ -3863,7 +3863,7 @@ TclExpandJumpFixupArray( void TclFreeJumpFixupArray( - register JumpFixupArray *fixupArrayPtr) + JumpFixupArray *fixupArrayPtr) /* Points to the JumpFixupArray structure to * free. */ { @@ -4310,7 +4310,7 @@ GetCmdLocEncodingSize( * containing the CmdLocation structure to * encode. */ { - register CmdLocation *mapPtr = envPtr->cmdMapPtr; + CmdLocation *mapPtr = envPtr->cmdMapPtr; int numCmds = envPtr->numCommands; int codeDelta, codeLen, srcDelta, srcLen; int codeDeltaNext, codeLengthNext, srcDeltaNext, srcLengthNext; @@ -4394,11 +4394,11 @@ EncodeCmdLocMap( * memory block where the location information * is to be stored. */ { - register CmdLocation *mapPtr = envPtr->cmdMapPtr; + CmdLocation *mapPtr = envPtr->cmdMapPtr; int numCmds = envPtr->numCommands; - register unsigned char *p = startPtr; + unsigned char *p = startPtr; int codeDelta, codeLen, srcDelta, srcLen, prevOffset; - register int i; + int i; /* * Encode the code offset for each command as a sequence of deltas. @@ -4512,7 +4512,7 @@ RecordByteCodeStats( * to add to accumulated statistics. */ { Interp *iPtr = (Interp *) *codePtr->interpHandle; - register ByteCodeStats *statsPtr; + ByteCodeStats *statsPtr; if (iPtr == NULL) { /* Avoid segfaulting in case we're called in a deleted interp */ diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 6b30f8b..5e39a21 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -1217,7 +1217,7 @@ MODULE_SCOPE Tcl_Obj *TclGetInnerContext(Tcl_Interp *interp, const unsigned char *pc, Tcl_Obj **tosPtr); MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData, - register Tcl_Interp *interp, int objc, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int isLambda); @@ -1405,7 +1405,7 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData, #define TclEmitPush(objIndex, envPtr) \ do { \ - register int _objIndexCopy = (objIndex); \ + int _objIndexCopy = (objIndex); \ if (_objIndexCopy <= 255) { \ TclEmitInstInt1(INST_PUSH1, _objIndexCopy, (envPtr)); \ } else { \ diff --git a/generic/tclDate.c b/generic/tclDate.c index 32c71de..87c6325 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -2549,9 +2549,9 @@ LookupWord( YYSTYPE* yylvalPtr, char *buff) { - register char *p; - register char *q; - register const TABLE *tp; + char *p; + char *q; + const TABLE *tp; int i, abbrev; /* @@ -2674,8 +2674,8 @@ TclDatelex( YYLTYPE* location, DateInfo *info) { - register char c; - register char *p; + char c; + char *p; char buff[20]; int Count; diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c index 76a4d46..3204619 100644 --- a/generic/tclDisassemble.c +++ b/generic/tclDisassemble.c @@ -542,7 +542,7 @@ FormatInstruction( { Proc *procPtr = codePtr->procPtr; unsigned char opCode = *pc; - register const InstructionDesc *instDesc = &tclInstructionTable[opCode]; + const InstructionDesc *instDesc = &tclInstructionTable[opCode]; unsigned char *codeStart = codePtr->codeStart; unsigned pcOffset = pc - codeStart; int opnd = 0, i, j, numBytes = 1; @@ -863,8 +863,8 @@ PrintSourceToObj( const char *stringPtr, /* The string to print. */ int maxChars) /* Maximum number of chars to print. */ { - register const char *p; - register int i = 0, len; + const char *p; + int i = 0, len; Tcl_UniChar ch = 0; if (stringPtr == NULL) { diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index e7e5c92..416eaad 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -119,7 +119,7 @@ static inline Tcl_Obj * NewNsObj( Tcl_Namespace *namespacePtr) { - register Namespace *nsPtr = (Namespace *) namespacePtr; + Namespace *nsPtr = (Namespace *) namespacePtr; if (namespacePtr == TclGetGlobalNamespace(nsPtr->interp)) { return Tcl_NewStringObj("::", 2); @@ -1813,7 +1813,7 @@ NsEnsembleImplementationCmdNR( subcmdName = TclGetStringFromObj(subObj, &stringLength); for (i=0 ; isubcommandArrayPtr[i], stringLength); @@ -2404,7 +2404,7 @@ MakeCachedEnsembleCommand( Tcl_HashEntry *hPtr, Tcl_Obj *fix) { - register EnsembleCmdRep *ensembleCmd; + EnsembleCmdRep *ensembleCmd; ECRGetIntRep(objPtr, ensembleCmd); if (ensembleCmd) { diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 520c2ee..871a463 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -1327,7 +1327,7 @@ int Tcl_ExprObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ - register Tcl_Obj *objPtr, /* Points to Tcl object containing expression + Tcl_Obj *objPtr, /* Points to Tcl object containing expression * to evaluate. */ Tcl_Obj **resultPtrPtr) /* Where the Tcl_Obj* that is the expression * result is stored if no errors occur. */ @@ -1444,7 +1444,7 @@ CompileExprObj( Interp *iPtr = (Interp *) interp; CompileEnv compEnv; /* Compilation environment structure allocated * in frame. */ - register ByteCode *codePtr = NULL; + ByteCode *codePtr = NULL; /* Tcl Internal type of bytecode. Initialized * to avoid compiler warning. */ @@ -1598,8 +1598,8 @@ TclCompileObj( const CmdFrame *invoker, int word) { - register Interp *iPtr = (Interp *) interp; - register ByteCode *codePtr; /* Tcl Internal type of bytecode. */ + Interp *iPtr = (Interp *) interp; + ByteCode *codePtr; /* Tcl Internal type of bytecode. */ Namespace *namespacePtr = iPtr->varFramePtr->nsPtr; /* @@ -2493,7 +2493,7 @@ TEBCresume( #ifdef TCL_COMPILE_DEBUG /* FIXME: What is the right thing to trace? */ { - register int i; + int i; TRACE(("%d [", opnd)); for (i=opnd-1 ; i>=0 ; i--) { @@ -4395,8 +4395,8 @@ TEBCresume( NEXT_INST_F(1, 0, 1); case INST_INFO_LEVEL_ARGS: { int level; - register CallFrame *framePtr = iPtr->varFramePtr; - register CallFrame *rootFramePtr = iPtr->rootFramePtr; + CallFrame *framePtr = iPtr->varFramePtr; + CallFrame *rootFramePtr = iPtr->rootFramePtr; TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS))); if (TclGetIntFromObj(interp, OBJ_AT_TOS, &level) != TCL_OK) { @@ -4693,7 +4693,7 @@ TEBCresume( } { - register Method *const mPtr = + Method *const mPtr = contextPtr->callPtr->chain[newDepth].mPtr; return mPtr->typePtr->callProc(mPtr->clientData, interp, @@ -6783,7 +6783,7 @@ TEBCresume( NEXT_INST_F(1, 1, 0); case INST_DICT_EXISTS: { - register int found; + int found; opnd = TclGetUInt4AtPtr(pc+1); TRACE(("%u => ", opnd)); @@ -8884,7 +8884,7 @@ TclCompareTwoNumbers( static void PrintByteCodeInfo( - register ByteCode *codePtr) /* The bytecode whose summary is printed to + ByteCode *codePtr) /* The bytecode whose summary is printed to * stdout. */ { Proc *procPtr = codePtr->procPtr; @@ -8948,7 +8948,7 @@ PrintByteCodeInfo( #ifdef TCL_COMPILE_DEBUG static void ValidatePcAndStackTop( - register ByteCode *codePtr, /* The bytecode whose summary is printed to + ByteCode *codePtr, /* The bytecode whose summary is printed to * stdout. */ const unsigned char *pc, /* Points to first byte of a bytecode * instruction. The program counter. */ @@ -9191,7 +9191,7 @@ GetSrcInfoForPc( * of the command containing the pc should * be stored. */ { - register int pcOffset = (pc - codePtr->codeStart); + int pcOffset = (pc - codePtr->codeStart); int numCmds = codePtr->numCommands; unsigned char *codeDeltaNext, *codeLengthNext; unsigned char *srcDeltaNext, *srcLengthNext; @@ -9344,9 +9344,9 @@ GetExceptRangeForPc( { ExceptionRange *rangeArrayPtr; int numRanges = codePtr->numExceptRanges; - register ExceptionRange *rangePtr; + ExceptionRange *rangePtr; int pcOffset = pc - codePtr->codeStart; - register int start; + int start; if (numRanges == 0) { return NULL; @@ -9478,11 +9478,11 @@ TclExprFloatError( int TclLog2( - register int value) /* The integer for which to compute the log + int value) /* The integer for which to compute the log * base 2. */ { - register int n = value; - register int result = 0; + int n = value; + int result = 0; while (n > 1) { n = n >> 1; diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 98ee37c..3419d7c 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -1072,7 +1072,7 @@ Tcl_TranslateFileName( */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { - register char *p; + char *p; for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) { if (*p == '/') { *p = '\\'; @@ -2077,7 +2077,7 @@ SkipToChar( int match) /* Character to find. */ { int quoted, level; - register char *p; + char *p; quoted = 0; level = 0; @@ -2628,7 +2628,7 @@ Tcl_GetBlocksFromStat( #ifdef HAVE_STRUCT_STAT_ST_BLOCKS return (Tcl_WideUInt) statPtr->st_blocks; #else - register unsigned blksize = Tcl_GetBlockSizeFromStat(statPtr); + unsigned blksize = Tcl_GetBlockSizeFromStat(statPtr); return ((Tcl_WideUInt) statPtr->st_size + blksize - 1) / blksize; #endif diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index 59f85bd..210e91c 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -765,9 +765,9 @@ LookupWord( YYSTYPE* yylvalPtr, char *buff) { - register char *p; - register char *q; - register const TABLE *tp; + char *p; + char *q; + const TABLE *tp; int i, abbrev; /* @@ -890,8 +890,8 @@ TclDatelex( YYLTYPE* location, DateInfo *info) { - register char c; - register char *p; + char c; + char *p; char buff[20]; int Count; diff --git a/generic/tclHash.c b/generic/tclHash.c index 8bbb0c7..9ea8807 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -113,7 +113,7 @@ const Tcl_HashKeyType tclStringHashKeyType = { void Tcl_InitHashTable( - register Tcl_HashTable *tablePtr, + Tcl_HashTable *tablePtr, /* Pointer to table record, which is supplied * by the caller. */ int keyType) /* Type of keys to use in table: @@ -151,7 +151,7 @@ Tcl_InitHashTable( void Tcl_InitCustomHashTable( - register Tcl_HashTable *tablePtr, + Tcl_HashTable *tablePtr, /* Pointer to table record, which is supplied * by the caller. */ int keyType, /* Type of keys to use in table: @@ -271,7 +271,7 @@ CreateHashEntry( int *newPtr) /* Store info here telling whether a new entry * was created. */ { - register Tcl_HashEntry *hPtr; + Tcl_HashEntry *hPtr; const Tcl_HashKeyType *typePtr; unsigned int hash; int index; @@ -392,7 +392,7 @@ void Tcl_DeleteHashEntry( Tcl_HashEntry *entryPtr) { - register Tcl_HashEntry *prevPtr; + Tcl_HashEntry *prevPtr; const Tcl_HashKeyType *typePtr; Tcl_HashTable *tablePtr; Tcl_HashEntry **bucketPtr; @@ -461,9 +461,9 @@ Tcl_DeleteHashEntry( void Tcl_DeleteHashTable( - register Tcl_HashTable *tablePtr) /* Table to delete. */ + Tcl_HashTable *tablePtr) /* Table to delete. */ { - register Tcl_HashEntry *hPtr, *nextPtr; + Tcl_HashEntry *hPtr, *nextPtr; const Tcl_HashKeyType *typePtr; int i; @@ -569,7 +569,7 @@ Tcl_FirstHashEntry( Tcl_HashEntry * Tcl_NextHashEntry( - register Tcl_HashSearch *searchPtr) + Tcl_HashSearch *searchPtr) /* Place to store information about progress * through the table. Must have been * initialized by calling @@ -616,7 +616,7 @@ Tcl_HashStats( #define NUM_COUNTERS 10 int count[NUM_COUNTERS], overflow, i, j; double average, tmp; - register Tcl_HashEntry *hPtr; + Tcl_HashEntry *hPtr; char *result, *p; /* @@ -686,7 +686,7 @@ AllocArrayEntry( void *keyPtr) /* Key to store in the hash table entry. */ { int *array = (int *) keyPtr; - register int *iPtr1, *iPtr2; + int *iPtr1, *iPtr2; Tcl_HashEntry *hPtr; int count; unsigned int size; @@ -730,8 +730,8 @@ CompareArrayKeys( void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { - register const int *iPtr1 = (const int *) keyPtr; - register const int *iPtr2 = (const int *) hPtr->key.words; + const int *iPtr1 = (const int *) keyPtr; + const int *iPtr2 = (const int *) hPtr->key.words; Tcl_HashTable *tablePtr = hPtr->tablePtr; int count; @@ -769,8 +769,8 @@ HashArrayKey( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key from which to compute hash value. */ { - register const int *array = (const int *) keyPtr; - register unsigned int result; + const int *array = (const int *) keyPtr; + unsigned int result; int count; for (result = 0, count = tablePtr->keyType; count > 0; @@ -838,8 +838,8 @@ CompareStringKeys( void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { - register const char *p1 = (const char *) keyPtr; - register const char *p2 = (const char *) hPtr->key.string; + const char *p1 = (const char *) keyPtr; + const char *p2 = (const char *) hPtr->key.string; return !strcmp(p1, p2); } @@ -866,9 +866,9 @@ HashStringKey( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key from which to compute hash value. */ { - register const char *string = keyPtr; - register unsigned int result; - register char c; + const char *string = keyPtr; + unsigned int result; + char c; /* * I tried a zillion different hash functions and asked many other people @@ -987,12 +987,12 @@ BogusCreate( static void RebuildTable( - register Tcl_HashTable *tablePtr) /* Table to enlarge. */ + Tcl_HashTable *tablePtr) /* Table to enlarge. */ { int count, index, oldSize = tablePtr->numBuckets; Tcl_HashEntry **oldBuckets = tablePtr->buckets; - register Tcl_HashEntry **oldChainPtr, **newChainPtr; - register Tcl_HashEntry *hPtr; + Tcl_HashEntry **oldChainPtr, **newChainPtr; + Tcl_HashEntry *hPtr; const Tcl_HashKeyType *typePtr; /* Avoid outgrowing capability of the memory allocators */ diff --git a/generic/tclHistory.c b/generic/tclHistory.c index 47806d4..46e6989 100644 --- a/generic/tclHistory.c +++ b/generic/tclHistory.c @@ -61,7 +61,7 @@ Tcl_RecordAndEval( * TCL_EVAL_GLOBAL means use Tcl_GlobalEval * instead of Tcl_Eval. */ { - register Tcl_Obj *cmdPtr; + Tcl_Obj *cmdPtr; int result; if (cmd[0]) { @@ -213,7 +213,7 @@ DeleteHistoryObjs( ClientData clientData, Tcl_Interp *interp) { - register HistoryObjs *histObjsPtr = clientData; + HistoryObjs *histObjsPtr = clientData; TclDecrRefCount(histObjsPtr->historyObj); TclDecrRefCount(histObjsPtr->addObj); diff --git a/generic/tclIO.c b/generic/tclIO.c index 118820a..f50ef4a 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -7480,7 +7480,7 @@ Tcl_OutputBuffered( bytesBuffered += BytesLeft(bufPtr); } if (statePtr->curOutPtr != NULL) { - register ChannelBuffer *curOutPtr = statePtr->curOutPtr; + ChannelBuffer *curOutPtr = statePtr->curOutPtr; if (IsBufferReady(curOutPtr)) { bytesBuffered += BytesLeft(curOutPtr); @@ -11235,9 +11235,9 @@ Tcl_ChannelTruncateProc( static void DupChannelIntRep( - register Tcl_Obj *srcPtr, /* Object with internal rep to copy. Must have + Tcl_Obj *srcPtr, /* Object with internal rep to copy. Must have * an internal rep of type "Channel". */ - register Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not + Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not * currently have an internal rep.*/ { ResolvedChanName *resPtr; diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 23049fb..1d90def 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -2125,7 +2125,7 @@ static Tcl_Obj * DecodeEventMask( int mask) { - register const char *eventStr; + const char *eventStr; Tcl_Obj *evObj; switch (mask & RANDW) { diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index 8e24cf7..8385d88 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -1706,7 +1706,7 @@ static Tcl_Obj * DecodeEventMask( int mask) { - register const char *eventStr; + const char *eventStr; Tcl_Obj *evObj; switch (mask & RANDW) { diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 919db92..e7c3b46 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -426,7 +426,7 @@ Tcl_GetIndexFromObjStruct( static int SetIndexFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - register Tcl_Obj *objPtr) /* The object to convert. */ + Tcl_Obj *objPtr) /* The object to convert. */ { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( @@ -458,7 +458,7 @@ UpdateStringOfIndex( Tcl_Obj *objPtr) { IndexRep *indexRep = TclFetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1; - register const char *indexStr = EXPAND_OF(indexRep); + const char *indexStr = EXPAND_OF(indexRep); Tcl_InitStringRep(objPtr, indexStr, strlen(indexStr)); } @@ -967,7 +967,7 @@ Tcl_WrongNumArgs( const Tcl_ObjIntRep *irPtr; if ((irPtr = TclFetchIntRep(origObjv[i], &indexType))) { - register IndexRep *indexRep = irPtr->twoPtrValue.ptr1; + IndexRep *indexRep = irPtr->twoPtrValue.ptr1; elementStr = EXPAND_OF(indexRep); elemLen = strlen(elementStr); @@ -1016,7 +1016,7 @@ Tcl_WrongNumArgs( const Tcl_ObjIntRep *irPtr; if ((irPtr = TclFetchIntRep(objv[i], &indexType))) { - register IndexRep *indexRep = irPtr->twoPtrValue.ptr1; + IndexRep *indexRep = irPtr->twoPtrValue.ptr1; Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL); } else { @@ -1107,14 +1107,14 @@ Tcl_ParseArgsObjv( * successful exit. Will include the name of * the command. */ int nrem; /* Size of leftovers.*/ - register const Tcl_ArgvInfo *infoPtr; + const Tcl_ArgvInfo *infoPtr; /* Pointer to the current entry in the table * of argument descriptions. */ const Tcl_ArgvInfo *matchPtr; /* Descriptor that matches current argument */ Tcl_Obj *curArg; /* Current argument */ const char *str = NULL; - register char c; /* Second character of current arg (used for + char c; /* Second character of current arg (used for * quick check for matching; use 2nd char. * because first char. will almost always be * '-'). */ @@ -1362,7 +1362,7 @@ PrintUsage( /* Array of command-specific argument * descriptions. */ { - register const Tcl_ArgvInfo *infoPtr; + const Tcl_ArgvInfo *infoPtr; int width, numSpaces; #define NUM_SPACES 20 static const char spaces[] = " "; diff --git a/generic/tclInt.h b/generic/tclInt.h index 7029173..3a6352a 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3076,6 +3076,7 @@ MODULE_SCOPE void TclInitObjSubsystem(void); MODULE_SCOPE void TclInitSubsystems(void); MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp); MODULE_SCOPE int TclIsSpaceProc(int byte); +MODULE_SCOPE int TclIsDigitProc(int byte); MODULE_SCOPE int TclIsBareword(int byte); MODULE_SCOPE Tcl_Obj * TclJoinPath(int elements, Tcl_Obj * const objv[], int forceRelative); @@ -4534,8 +4535,8 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, #define TclUnpackBignum(objPtr, bignum) \ do { \ - register Tcl_Obj *bignumObj = (objPtr); \ - register int bignumPayload = \ + Tcl_Obj *bignumObj = (objPtr); \ + int bignumPayload = \ PTR2INT(bignumObj->internalRep.twoPtrValue.ptr2); \ if (bignumPayload == -1) { \ (bignum) = *((mp_int *) bignumObj->internalRep.twoPtrValue.ptr1); \ diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 92c6159..3188fce 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -3362,7 +3362,7 @@ int Tcl_LimitExceeded( Tcl_Interp *interp) { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; return iPtr->limit.exceeded != 0; } @@ -3393,10 +3393,10 @@ int Tcl_LimitReady( Tcl_Interp *interp) { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; if (iPtr->limit.active != 0) { - register int ticker = ++iPtr->limit.granularityTicker; + int ticker = ++iPtr->limit.granularityTicker; if ((iPtr->limit.active & TCL_LIMIT_COMMANDS) && ((iPtr->limit.cmdGranularity == 1) || @@ -3440,7 +3440,7 @@ Tcl_LimitCheck( Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; - register int ticker = iPtr->limit.granularityTicker; + int ticker = iPtr->limit.granularityTicker; if (Tcl_InterpDeleted(interp)) { return TCL_OK; diff --git a/generic/tclListObj.c b/generic/tclListObj.c index ad64971..d4dec9b 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -557,14 +557,14 @@ TclListObjRange( int Tcl_ListObjGetElements( Tcl_Interp *interp, /* Used to report errors if not NULL. */ - register Tcl_Obj *listPtr, /* List object for which an element array is + Tcl_Obj *listPtr, /* List object for which an element array is * to be returned. */ int *objcPtr, /* Where to store the count of objects * referenced by objv. */ Tcl_Obj ***objvPtr) /* Where to store the pointer to an array of * pointers to the list's objects. */ { - register List *listRepPtr; + List *listRepPtr; ListGetIntRep(listPtr, listRepPtr); @@ -614,7 +614,7 @@ Tcl_ListObjGetElements( int Tcl_ListObjAppendList( Tcl_Interp *interp, /* Used to report errors if not NULL. */ - register Tcl_Obj *listPtr, /* List object to append elements to. */ + Tcl_Obj *listPtr, /* List object to append elements to. */ Tcl_Obj *elemListPtr) /* List obj with elements to append. */ { int objc; @@ -673,7 +673,7 @@ Tcl_ListObjAppendElement( Tcl_Obj *listPtr, /* List object to append objPtr to. */ Tcl_Obj *objPtr) /* Object to append to listPtr's list. */ { - register List *listRepPtr, *newPtr = NULL; + List *listRepPtr, *newPtr = NULL; int numElems, numRequired, needGrow, isShared, attempt; if (Tcl_IsShared(listPtr)) { @@ -844,11 +844,11 @@ Tcl_ListObjAppendElement( int Tcl_ListObjIndex( Tcl_Interp *interp, /* Used to report errors if not NULL. */ - register Tcl_Obj *listPtr, /* List object to index into. */ - register int index, /* Index of element to return. */ + Tcl_Obj *listPtr, /* List object to index into. */ + int index, /* Index of element to return. */ Tcl_Obj **objPtrPtr) /* The resulting Tcl_Obj* is stored here. */ { - register List *listRepPtr; + List *listRepPtr; ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { @@ -900,10 +900,10 @@ Tcl_ListObjIndex( int Tcl_ListObjLength( Tcl_Interp *interp, /* Used to report errors if not NULL. */ - register Tcl_Obj *listPtr, /* List object whose #elements to return. */ - register int *intPtr) /* The resulting int is stored here. */ + Tcl_Obj *listPtr, /* List object whose #elements to return. */ + int *intPtr) /* The resulting int is stored here. */ { - register List *listRepPtr; + List *listRepPtr; ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { @@ -974,7 +974,7 @@ Tcl_ListObjReplace( * insert. */ { List *listRepPtr; - register Tcl_Obj **elemPtrs; + Tcl_Obj **elemPtrs; int needGrow, numElems, numRequired, numAfterLast, start, i, j, isShared; if (Tcl_IsShared(listPtr)) { diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index 2f93200..50f8e38 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -58,7 +58,7 @@ static void RebuildLiteralTable(LiteralTable *tablePtr); void TclInitLiteralTable( - register LiteralTable *tablePtr) + LiteralTable *tablePtr) /* Pointer to table structure, which is * supplied by the caller. */ { @@ -389,7 +389,7 @@ int TclRegisterLiteral( void *ePtr, /* Points to the CompileEnv in whose object * array an object is found or created. */ - register const char *bytes, /* Points to string for which to find or + const char *bytes, /* Points to string for which to find or * create an object in CompileEnv's object * array. */ int length, /* Number of bytes in the string. If < 0, the @@ -499,13 +499,13 @@ static LiteralEntry * LookupLiteralEntry( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ - register Tcl_Obj *objPtr) /* Points to a Tcl object holding a literal + Tcl_Obj *objPtr) /* Points to a Tcl object holding a literal * that was previously created by a call to * TclRegisterLiteral. */ { Interp *iPtr = (Interp *) interp; LiteralTable *globalTablePtr = &iPtr->literalTable; - register LiteralEntry *entryPtr; + LiteralEntry *entryPtr; const char *bytes; int length, globalHash; @@ -545,7 +545,7 @@ void TclHideLiteral( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ - register CompileEnv *envPtr,/* Points to CompileEnv whose literal array + CompileEnv *envPtr,/* Points to CompileEnv whose literal array * contains the entry being hidden. */ int index) /* The index of the entry in the literal * array. */ @@ -609,14 +609,14 @@ TclHideLiteral( int TclAddLiteralObj( - register CompileEnv *envPtr,/* Points to CompileEnv in whose literal array + CompileEnv *envPtr,/* Points to CompileEnv in whose literal array * the object is to be inserted. */ Tcl_Obj *objPtr, /* The object to insert into the array. */ LiteralEntry **litPtrPtr) /* The location where the pointer to the new * literal entry should be stored. May be * NULL. */ { - register LiteralEntry *lPtr; + LiteralEntry *lPtr; int objIndex; if (envPtr->literalArrayNext >= envPtr->literalArrayEnd) { @@ -658,12 +658,12 @@ TclAddLiteralObj( static int AddLocalLiteralEntry( - register CompileEnv *envPtr,/* Points to CompileEnv in whose literal array + CompileEnv *envPtr,/* Points to CompileEnv in whose literal array * the object is to be inserted. */ Tcl_Obj *objPtr, /* The literal to add to the CompileEnv. */ int localHash) /* Hash value for the literal's string. */ { - register LiteralTable *localTablePtr = &envPtr->localLitTable; + LiteralTable *localTablePtr = &envPtr->localLitTable; LiteralEntry *localPtr; int objIndex; @@ -736,7 +736,7 @@ AddLocalLiteralEntry( static void ExpandLocalLiteralArray( - register CompileEnv *envPtr)/* Points to the CompileEnv whose object array + CompileEnv *envPtr)/* Points to the CompileEnv whose object array * must be enlarged. */ { /* @@ -818,13 +818,13 @@ void TclReleaseLiteral( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ - register Tcl_Obj *objPtr) /* Points to a literal object that was + Tcl_Obj *objPtr) /* Points to a literal object that was * previously created by a call to * TclRegisterLiteral. */ { Interp *iPtr = (Interp *) interp; LiteralTable *globalTablePtr; - register LiteralEntry *entryPtr, *prevPtr; + LiteralEntry *entryPtr, *prevPtr; const char *bytes; int length; unsigned int index; @@ -898,10 +898,10 @@ TclReleaseLiteral( static unsigned HashString( - register const char *string, /* String for which to compute hash value. */ + const char *string, /* String for which to compute hash value. */ int length) /* Number of bytes in the string. */ { - register unsigned int result = 0; + unsigned int result = 0; /* * I tried a zillion different hash functions and asked many other people @@ -962,12 +962,12 @@ HashString( static void RebuildLiteralTable( - register LiteralTable *tablePtr) + LiteralTable *tablePtr) /* Local or global table to enlarge. */ { LiteralEntry **oldBuckets; - register LiteralEntry **oldChainPtr, **newChainPtr; - register LiteralEntry *entryPtr; + LiteralEntry **oldChainPtr, **newChainPtr; + LiteralEntry *entryPtr; LiteralEntry **bucketPtr; const char *bytes; unsigned int oldSize, index; @@ -1098,7 +1098,7 @@ TclLiteralStats( int overflow; size_t i, j; double average, tmp; - register LiteralEntry *entryPtr; + LiteralEntry *entryPtr; char *result, *p; /* @@ -1169,8 +1169,8 @@ TclVerifyLocalLiteralTable( CompileEnv *envPtr) /* Points to CompileEnv whose literal table is * to be validated. */ { - register LiteralTable *localTablePtr = &envPtr->localLitTable; - register LiteralEntry *localPtr; + LiteralTable *localTablePtr = &envPtr->localLitTable; + LiteralEntry *localPtr; char *bytes; size_t i, count; int length; @@ -1220,8 +1220,8 @@ TclVerifyGlobalLiteralTable( Interp *iPtr) /* Points to interpreter whose global literal * table is to be validated. */ { - register LiteralTable *globalTablePtr = &iPtr->literalTable; - register LiteralEntry *globalPtr; + LiteralTable *globalTablePtr = &iPtr->literalTable; + LiteralEntry *globalPtr; char *bytes; size_t i, count; int length; diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index bbe357d..9f28661 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -240,7 +240,7 @@ TclInitNamespaceSubsystem(void) Tcl_Namespace * Tcl_GetCurrentNamespace( - register Tcl_Interp *interp)/* Interpreter whose current namespace is + Tcl_Interp *interp)/* Interpreter whose current namespace is * being queried. */ { return TclGetCurrentNamespace(interp); @@ -264,7 +264,7 @@ Tcl_GetCurrentNamespace( Tcl_Namespace * Tcl_GetGlobalNamespace( - register Tcl_Interp *interp)/* Interpreter whose global namespace should + Tcl_Interp *interp)/* Interpreter whose global namespace should * be returned. */ { return TclGetGlobalNamespace(interp); @@ -316,8 +316,8 @@ Tcl_PushCallFrame( * variables. */ { Interp *iPtr = (Interp *) interp; - register CallFrame *framePtr = (CallFrame *) callFramePtr; - register Namespace *nsPtr; + CallFrame *framePtr = (CallFrame *) callFramePtr; + Namespace *nsPtr; if (namespacePtr == NULL) { nsPtr = (Namespace *) TclGetCurrentNamespace(interp); @@ -393,8 +393,8 @@ void Tcl_PopCallFrame( Tcl_Interp *interp) /* Interpreter with call frame to pop. */ { - register Interp *iPtr = (Interp *) interp; - register CallFrame *framePtr = iPtr->framePtr; + Interp *iPtr = (Interp *) interp; + CallFrame *framePtr = iPtr->framePtr; Namespace *nsPtr; /* @@ -679,7 +679,7 @@ Tcl_CreateNamespace( * function should be called. */ { Interp *iPtr = (Interp *) interp; - register Namespace *nsPtr, *ancestorPtr; + Namespace *nsPtr, *ancestorPtr; Namespace *parentPtr, *dummy1Ptr, *dummy2Ptr; Namespace *globalNsPtr = iPtr->globalNsPtr; const char *simpleName; @@ -848,7 +848,7 @@ Tcl_CreateNamespace( for (ancestorPtr = nsPtr; ancestorPtr != NULL; ancestorPtr = ancestorPtr->parentPtr) { if (ancestorPtr != globalNsPtr) { - register Tcl_DString *tempPtr = namePtr; + Tcl_DString *tempPtr = namePtr; TclDStringAppendLiteral(buffPtr, "::"); Tcl_DStringAppend(buffPtr, ancestorPtr->name, -1); @@ -922,7 +922,7 @@ void Tcl_DeleteNamespace( Tcl_Namespace *namespacePtr)/* Points to the namespace to delete. */ { - register Namespace *nsPtr = (Namespace *) namespacePtr; + Namespace *nsPtr = (Namespace *) namespacePtr; Interp *iPtr = (Interp *) nsPtr->interp; Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace((Tcl_Interp *) iPtr); @@ -1118,11 +1118,11 @@ TclNamespaceDeleted( void TclTeardownNamespace( - register Namespace *nsPtr) /* Points to the namespace to be dismantled + Namespace *nsPtr) /* Points to the namespace to be dismantled * and unlinked from its parent. */ { Interp *iPtr = (Interp *) nsPtr->interp; - register Tcl_HashEntry *entryPtr; + Tcl_HashEntry *entryPtr; Tcl_HashSearch search; int i; @@ -1311,7 +1311,7 @@ TclTeardownNamespace( static void NamespaceFree( - register Namespace *nsPtr) /* Points to the namespace to free. */ + Namespace *nsPtr) /* Points to the namespace to free. */ { /* * Most of the namespace's contents are freed when the namespace is @@ -1586,7 +1586,7 @@ Tcl_Import( { Namespace *nsPtr, *importNsPtr, *dummyPtr; const char *simplePattern; - register Tcl_HashEntry *hPtr; + Tcl_HashEntry *hPtr; Tcl_HashSearch search; /* @@ -1865,7 +1865,7 @@ Tcl_ForgetImport( Namespace *nsPtr, *sourceNsPtr, *dummyPtr; const char *simplePattern; char *cmdName; - register Tcl_HashEntry *hPtr; + Tcl_HashEntry *hPtr; Tcl_HashSearch search; /* @@ -1992,7 +1992,7 @@ TclGetOriginalCommand( Tcl_Command command) /* The imported command for which the original * command should be returned. */ { - register Command *cmdPtr = (Command *) command; + Command *cmdPtr = (Command *) command; ImportedCmdData *dataPtr; if (cmdPtr->deleteProc != DeleteImportedCmd) { @@ -2081,7 +2081,7 @@ DeleteImportedCmd( ImportedCmdData *dataPtr = clientData; Command *realCmdPtr = dataPtr->realCmdPtr; Command *selfPtr = dataPtr->selfPtr; - register ImportRef *refPtr, *prevPtr; + ImportRef *refPtr, *prevPtr; prevPtr = NULL; for (refPtr = realCmdPtr->importRefPtr; refPtr != NULL; @@ -2501,7 +2501,7 @@ Tcl_FindNamespace( * points to namespace in which to resolve * name; if NULL, look up name in the current * namespace. */ - register int flags) /* Flags controlling namespace lookup: an OR'd + int flags) /* Flags controlling namespace lookup: an OR'd * combination of TCL_GLOBAL_ONLY and * TCL_LEAVE_ERR_MSG flags. */ { @@ -2572,8 +2572,8 @@ Tcl_FindCommand( { Interp *iPtr = (Interp *) interp; Namespace *cxtNsPtr; - register Tcl_HashEntry *entryPtr; - register Command *cmdPtr; + Tcl_HashEntry *entryPtr; + Command *cmdPtr; const char *simpleName; int result; @@ -2684,7 +2684,7 @@ Tcl_FindCommand( } } else { Namespace *nsPtr[2]; - register int search; + int search; TclGetNamespaceForQualName(interp, name, cxtNsPtr, flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName); @@ -2758,7 +2758,7 @@ TclResetShadowedCmdRefs( { char *cmdName; Tcl_HashEntry *hPtr; - register Namespace *nsPtr; + Namespace *nsPtr; Namespace *trailNsPtr, *shadowNsPtr; Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp); int found, i; @@ -3008,7 +3008,7 @@ NamespaceChildrenCmd( Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp); const char *pattern = NULL; Tcl_DString buffer; - register Tcl_HashEntry *entryPtr; + Tcl_HashEntry *entryPtr; Tcl_HashSearch search; Tcl_Obj *listPtr, *elemPtr; @@ -3134,7 +3134,7 @@ NamespaceCodeCmd( { Namespace *currNsPtr; Tcl_Obj *listPtr, *objPtr; - register const char *arg; + const char *arg; int length; if (objc != 2) { @@ -3213,7 +3213,7 @@ NamespaceCurrentCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - register Namespace *currNsPtr; + Namespace *currNsPtr; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); @@ -3278,7 +3278,7 @@ NamespaceDeleteCmd( { Tcl_Namespace *namespacePtr; const char *name; - register int i; + int i; if (objc < 1) { Tcl_WrongNumArgs(interp, 1, objv, "?name name...?"); @@ -3633,7 +3633,7 @@ NamespaceForgetCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { const char *pattern; - register int i, result; + int i, result; if (objc < 1) { Tcl_WrongNumArgs(interp, 1, objv, "?pattern pattern...?"); @@ -3699,7 +3699,7 @@ NamespaceImportCmd( { int allowOverwrite = 0; const char *string, *pattern; - register int i, result; + int i, result; int firstArg; if (objc < 1) { @@ -3852,7 +3852,7 @@ NRNamespaceInscopeCmd( cmdObjPtr = objv[2]; } else { Tcl_Obj *concatObjv[2]; - register Tcl_Obj *listPtr; + Tcl_Obj *listPtr; listPtr = Tcl_NewListObj(0, NULL); for (i = 3; i < objc; i++) { @@ -4253,7 +4253,7 @@ NamespaceQualifiersCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - register const char *name, *p; + const char *name, *p; int length; if (objc != 2) { @@ -4508,7 +4508,7 @@ NamespaceTailCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - register const char *name, *p; + const char *name, *p; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "string"); @@ -4711,7 +4711,7 @@ NamespaceWhichCmd( static void FreeNsNameInternalRep( - register Tcl_Obj *objPtr) /* nsName object with internal representation + Tcl_Obj *objPtr) /* nsName object with internal representation * to free. */ { ResolvedNsName *resNamePtr; @@ -4758,7 +4758,7 @@ FreeNsNameInternalRep( static void DupNsNameInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ - register Tcl_Obj *copyPtr) /* Object with internal rep to set. */ + Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { ResolvedNsName *resNamePtr; @@ -4794,11 +4794,11 @@ SetNsNameFromAny( Tcl_Interp *interp, /* Points to the namespace in which to resolve * name. Also used for error reporting if not * NULL. */ - register Tcl_Obj *objPtr) /* The object to convert. */ + Tcl_Obj *objPtr) /* The object to convert. */ { const char *dummy; Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr; - register ResolvedNsName *resNamePtr; + ResolvedNsName *resNamePtr; const char *name; if (interp == NULL) { @@ -4921,7 +4921,7 @@ TclLogCommandInfo( Tcl_Obj **tosPtr) /* Current stack of bytecode execution * context */ { - register const char *p; + const char *p; Interp *iPtr = (Interp *) interp; int overflow, limit = 150; Var *varPtr, *arrayPtr; diff --git a/generic/tclOO.c b/generic/tclOO.c index e9cc0f0..1ba262b 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -789,7 +789,7 @@ MyDeleted( ClientData clientData) /* Reference to the object whose [my] has been * squelched. */ { - register Object *oPtr = clientData; + Object *oPtr = clientData; oPtr->myCommand = NULL; } @@ -1652,7 +1652,7 @@ Tcl_NewObjectInstance( int skip) /* Number of arguments to _not_ pass to the * constructor. */ { - register Class *classPtr = (Class *) cls; + Class *classPtr = (Class *) cls; Object *oPtr; ClientData clientData[4]; @@ -1722,7 +1722,7 @@ TclNRNewObjectInstance( Tcl_Object *objectPtr) /* Place to write the object reference upon * successful allocation. */ { - register Class *classPtr = (Class *) cls; + Class *classPtr = (Class *) cls; CallContext *contextPtr; Tcl_InterpState state; Object *oPtr; @@ -2656,7 +2656,7 @@ TclOOObjectCmdCore( methodNamePtr = objv[1]; if (oPtr->mapMethodNameProc != NULL) { - register Class **startClsPtr = &startCls; + Class **startClsPtr = &startCls; Tcl_Obj *mappedMethodName = Tcl_DuplicateObj(methodNamePtr); result = oPtr->mapMethodNameProc(interp, (Tcl_Object) oPtr, @@ -2715,7 +2715,7 @@ TclOOObjectCmdCore( if (startCls != NULL) { for (; contextPtr->index < contextPtr->callPtr->numChain; contextPtr->index++) { - register struct MInvoke *miPtr = + struct MInvoke *miPtr = &contextPtr->callPtr->chain[contextPtr->index]; if (miPtr->isFilter) { @@ -2853,7 +2853,7 @@ TclNRObjectContextInvokeNext( Tcl_Obj *const *objv, int skip) { - register CallContext *contextPtr = (CallContext *) context; + CallContext *contextPtr = (CallContext *) context; if (contextPtr->index + 1 >= contextPtr->callPtr->numChain) { /* diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index 13c98f4..6de7513 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -426,7 +426,7 @@ TclOO_Object_Eval( { CallContext *contextPtr = (CallContext *) context; Tcl_Object object = Tcl_ObjectContextObject(context); - register const int skip = Tcl_ObjectContextSkippedArgs(context); + const int skip = Tcl_ObjectContextSkippedArgs(context); CallFrame *framePtr, **framePtrPtr = &framePtr; Tcl_Obj *scriptPtr; CmdFrame *invoker; @@ -1122,7 +1122,7 @@ TclOOSelfObjCmd( Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL); return TCL_ERROR; } else { - register struct MInvoke *miPtr = &CurrentlyInvoked(contextPtr); + struct MInvoke *miPtr = &CurrentlyInvoked(contextPtr); Object *oPtr; const char *type; diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index c0d2e64..f3474b6 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -168,7 +168,7 @@ void TclOODeleteContext( CallContext *contextPtr) { - register Object *oPtr = contextPtr->oPtr; + Object *oPtr = contextPtr->oPtr; TclOODeleteChain(contextPtr->callPtr); if (oPtr != NULL) { @@ -314,7 +314,7 @@ TclOOInvokeContext( int objc, /* The number of arguments. */ Tcl_Obj *const objv[]) /* The arguments as actually seen. */ { - register CallContext *const contextPtr = clientData; + CallContext *const contextPtr = clientData; Method *const mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; const int isFilter = contextPtr->callPtr->chain[contextPtr->index].isFilter; @@ -968,7 +968,7 @@ AddMethodToCallChain( * looking to add things from a mixin and have * not passed a mixin. */ { - register CallChain *callPtr = cbPtr->callChainPtr; + CallChain *callPtr = cbPtr->callChainPtr; int i; /* @@ -1656,7 +1656,7 @@ AddPrivatesFromClassChainToCallContext( (char *) methodName); if (hPtr != NULL) { - register Method *mPtr = Tcl_GetHashValue(hPtr); + Method *mPtr = Tcl_GetHashValue(hPtr); if (IS_PRIVATE(mPtr)) { AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl, @@ -1740,7 +1740,7 @@ AddSimpleClassChainToCallContext( privateDanger |= 1; } if (hPtr != NULL) { - register Method *mPtr = Tcl_GetHashValue(hPtr); + Method *mPtr = Tcl_GetHashValue(hPtr); if (!IS_PRIVATE(mPtr)) { if (!(flags & KNOWN_STATE)) { diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index 6a00018..a3aec0b 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -779,7 +779,7 @@ FindCommand( { int length; const char *nameStr, *string = TclGetStringFromObj(stringObj, &length); - register Namespace *const nsPtr = (Namespace *) namespacePtr; + Namespace *const nsPtr = (Namespace *) namespacePtr; FOREACH_HASH_DECLS; Tcl_Command cmd, cmd2; diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index c1a9010..1f44ef8 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -671,7 +671,7 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr); #undef DUPLICATE /* prevent possible conflict with definition in WINAPI nb30.h */ #define DUPLICATE(target,source,type) \ do { \ - register unsigned len = sizeof(type) * ((target).num=(source).num);\ + unsigned len = sizeof(type) * ((target).num=(source).num);\ if (len != 0) { \ memcpy(((target).list=(type*)ckalloc(len)), (source).list, len); \ } else { \ diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 32dd3c7..78421e1 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -149,8 +149,8 @@ Tcl_NewInstanceMethod( void *clientData) /* Some data associated with the particular * method to be created. */ { - register Object *oPtr = (Object *) object; - register Method *mPtr; + Object *oPtr = (Object *) object; + Method *mPtr; Tcl_HashEntry *hPtr; int isNew; @@ -221,8 +221,8 @@ Tcl_NewMethod( void *clientData) /* Some data associated with the particular * method to be created. */ { - register Class *clsPtr = (Class *) cls; - register Method *mPtr; + Class *clsPtr = (Class *) cls; + Method *mPtr; Tcl_HashEntry *hPtr; int isNew; @@ -344,7 +344,7 @@ TclOONewProcInstanceMethod( * interested. */ { int argsLen; - register ProcedureMethod *pmPtr; + ProcedureMethod *pmPtr; Tcl_Method method; if (Tcl_ListObjLength(interp, argsObj, &argsLen) != TCL_OK) { @@ -396,7 +396,7 @@ TclOONewProcMethod( * interested. */ { int argsLen; /* -1 => delete argsObj before exit */ - register ProcedureMethod *pmPtr; + ProcedureMethod *pmPtr; const char *procName; Tcl_Method method; @@ -796,7 +796,7 @@ PushMethodCallFrame( * frame. */ { Namespace *nsPtr = (Namespace *) contextPtr->oPtr->namespacePtr; - register int result; + int result; const char *namePtr; CallFrame **framePtrPtr = &fdPtr->framePtr; ByteCode *codePtr; @@ -829,7 +829,7 @@ PushMethodCallFrame( */ if (pmPtr->flags & USE_DECLARER_NS) { - register Method *mPtr = + Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; if (mPtr->declaringClassPtr != NULL) { @@ -900,7 +900,7 @@ PushMethodCallFrame( fdPtr->efi.fields[1].proc = pmPtr->gfivProc; fdPtr->efi.fields[1].clientData = pmPtr; } else { - register Tcl_Method method = + Tcl_Method method = Tcl_ObjectContextMethod((Tcl_ObjectContext) contextPtr); if (Tcl_MethodDeclarerObject(method) != NULL) { @@ -1294,7 +1294,7 @@ static void DeleteProcedureMethod( void *clientData) { - register ProcedureMethod *pmPtr = clientData; + ProcedureMethod *pmPtr = clientData; if (pmPtr->refCount-- <= 1) { DeleteProcedureMethodRecord(pmPtr); @@ -1387,7 +1387,7 @@ TclOONewForwardInstanceMethod( * prefix to forward to. */ { int prefixLen; - register ForwardMethod *fmPtr; + ForwardMethod *fmPtr; if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) { return NULL; @@ -1426,7 +1426,7 @@ TclOONewForwardMethod( * prefix to forward to. */ { int prefixLen; - register ForwardMethod *fmPtr; + ForwardMethod *fmPtr; if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) { return NULL; diff --git a/generic/tclObj.c b/generic/tclObj.c index d329aba..5c8217a 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -811,7 +811,7 @@ TclThreadFinalizeContLines( * * Tcl_RegisterObjType -- * - * This function is called to register a new Tcl object type in the table + * This function is called to a new Tcl object type in the table * of all object types supported by Tcl. * * Results: @@ -870,7 +870,7 @@ Tcl_AppendAllObjTypes( * name of each registered type is appended as * a list element. */ { - register Tcl_HashEntry *hPtr; + Tcl_HashEntry *hPtr; Tcl_HashSearch search; int numElems; @@ -918,7 +918,7 @@ const Tcl_ObjType * Tcl_GetObjType( const char *typeName) /* Name of Tcl object type to look up. */ { - register Tcl_HashEntry *hPtr; + Tcl_HashEntry *hPtr; const Tcl_ObjType *typePtr = NULL; Tcl_MutexLock(&tableMutex); @@ -1048,10 +1048,10 @@ TclDbDumpActiveObjects( #ifdef TCL_MEM_DEBUG void TclDbInitNewObj( - register Tcl_Obj *objPtr, - register const char *file, /* The name of the source file calling this + Tcl_Obj *objPtr, + const char *file, /* The name of the source file calling this * function; used for debugging. */ - register int line) /* Line number in the source file; used for + int line) /* Line number in the source file; used for * debugging. */ { objPtr->refCount = 0; @@ -1135,7 +1135,7 @@ Tcl_NewObj(void) Tcl_Obj * Tcl_NewObj(void) { - register Tcl_Obj *objPtr; + Tcl_Obj *objPtr; /* * Use the macro defined in tclInt.h - it will use the correct allocator. @@ -1177,12 +1177,12 @@ Tcl_NewObj(void) Tcl_Obj * Tcl_DbNewObj( - register const char *file, /* The name of the source file calling this + const char *file, /* The name of the source file calling this * function; used for debugging. */ - register int line) /* Line number in the source file; used for + int line) /* Line number in the source file; used for * debugging. */ { - register Tcl_Obj *objPtr; + Tcl_Obj *objPtr; /* * Use the macro defined in tclInt.h - it will use the correct allocator. @@ -1232,8 +1232,8 @@ TclAllocateFreeObjects(void) { size_t bytesToAlloc = (OBJS_TO_ALLOC_EACH_TIME * sizeof(Tcl_Obj)); char *basePtr; - register Tcl_Obj *prevPtr, *objPtr; - register int i; + Tcl_Obj *prevPtr, *objPtr; + int i; /* * This has been noted by Purify to be a potential leak. The problem is @@ -1284,9 +1284,9 @@ TclAllocateFreeObjects(void) #ifdef TCL_MEM_DEBUG void TclFreeObj( - register Tcl_Obj *objPtr) /* The object to be freed. */ + Tcl_Obj *objPtr) /* The object to be freed. */ { - register const Tcl_ObjType *typePtr = objPtr->typePtr; + const Tcl_ObjType *typePtr = objPtr->typePtr; /* * This macro declares a variable, so must come here... @@ -1409,7 +1409,7 @@ TclFreeObj( void TclFreeObj( - register Tcl_Obj *objPtr) /* The object to be freed. */ + Tcl_Obj *objPtr) /* The object to be freed. */ { /* * Invalidate the string rep first so we can use the bytes value for our @@ -1618,7 +1618,7 @@ TclSetDuplicateObj( char * Tcl_GetString( - register Tcl_Obj *objPtr) /* Object whose string rep byte pointer should + Tcl_Obj *objPtr) /* Object whose string rep byte pointer should * be returned. */ { if (objPtr->bytes == NULL) { @@ -1674,9 +1674,9 @@ Tcl_GetString( char * Tcl_GetStringFromObj( - register Tcl_Obj *objPtr, /* Object whose string rep byte pointer should + Tcl_Obj *objPtr, /* Object whose string rep byte pointer should * be returned. */ - register int *lengthPtr) /* If non-NULL, the location where the string + int *lengthPtr) /* If non-NULL, the location where the string * rep's byte array length should * be stored. * If NULL, no length is stored. */ { @@ -1816,7 +1816,7 @@ Tcl_InitStringRep( void Tcl_InvalidateStringRep( - register Tcl_Obj *objPtr) /* Object whose string rep byte pointer should + Tcl_Obj *objPtr) /* Object whose string rep byte pointer should * be freed. */ { TclInvalidateStringRep(objPtr); @@ -1961,7 +1961,7 @@ Tcl_FreeIntRep( Tcl_Obj * Tcl_NewBooleanObj( - register int boolValue) /* Boolean used to initialize new object. */ + int boolValue) /* Boolean used to initialize new object. */ { return Tcl_DbNewWideIntObj(boolValue!=0, "unknown", 0); } @@ -1970,9 +1970,9 @@ Tcl_NewBooleanObj( Tcl_Obj * Tcl_NewBooleanObj( - register int boolValue) /* Boolean used to initialize new object. */ + int boolValue) /* Boolean used to initialize new object. */ { - register Tcl_Obj *objPtr; + Tcl_Obj *objPtr; TclNewIntObj(objPtr, boolValue!=0); return objPtr; @@ -2011,13 +2011,13 @@ Tcl_NewBooleanObj( Tcl_Obj * Tcl_DbNewBooleanObj( - register int boolValue, /* Boolean used to initialize new object. */ + int boolValue, /* Boolean used to initialize new object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { - register Tcl_Obj *objPtr; + Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); /* Optimized TclInvalidateStringRep() */ @@ -2032,7 +2032,7 @@ Tcl_DbNewBooleanObj( Tcl_Obj * Tcl_DbNewBooleanObj( - register int boolValue, /* Boolean used to initialize new object. */ + int boolValue, /* Boolean used to initialize new object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for @@ -2063,8 +2063,8 @@ Tcl_DbNewBooleanObj( #undef Tcl_SetBooleanObj void Tcl_SetBooleanObj( - register Tcl_Obj *objPtr, /* Object whose internal rep to init. */ - register int boolValue) /* Boolean used to set object's value. */ + Tcl_Obj *objPtr, /* Object whose internal rep to init. */ + int boolValue) /* Boolean used to set object's value. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj"); @@ -2096,8 +2096,8 @@ Tcl_SetBooleanObj( int Tcl_GetBooleanFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - register Tcl_Obj *objPtr, /* The object from which to get boolean. */ - register int *boolPtr) /* Place to store resulting boolean. */ + Tcl_Obj *objPtr, /* The object from which to get boolean. */ + int *boolPtr) /* Place to store resulting boolean. */ { do { if (objPtr->typePtr == &tclIntType) { @@ -2162,7 +2162,7 @@ Tcl_GetBooleanFromObj( int TclSetBooleanFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - register Tcl_Obj *objPtr) /* The object to convert. */ + Tcl_Obj *objPtr) /* The object to convert. */ { /* * For some "pure" numeric Tcl_ObjTypes (no string rep), we can determine @@ -2208,7 +2208,7 @@ TclSetBooleanFromAny( static int ParseBoolean( - register Tcl_Obj *objPtr) /* The object to parse/convert. */ + Tcl_Obj *objPtr) /* The object to parse/convert. */ { int newBool; char lowerCase[6]; @@ -2350,7 +2350,7 @@ ParseBoolean( Tcl_Obj * Tcl_NewDoubleObj( - register double dblValue) /* Double used to initialize the object. */ + double dblValue) /* Double used to initialize the object. */ { return Tcl_DbNewDoubleObj(dblValue, "unknown", 0); } @@ -2359,9 +2359,9 @@ Tcl_NewDoubleObj( Tcl_Obj * Tcl_NewDoubleObj( - register double dblValue) /* Double used to initialize the object. */ + double dblValue) /* Double used to initialize the object. */ { - register Tcl_Obj *objPtr; + Tcl_Obj *objPtr; TclNewDoubleObj(objPtr, dblValue); return objPtr; @@ -2398,13 +2398,13 @@ Tcl_NewDoubleObj( Tcl_Obj * Tcl_DbNewDoubleObj( - register double dblValue, /* Double used to initialize the object. */ + double dblValue, /* Double used to initialize the object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { - register Tcl_Obj *objPtr; + Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); /* Optimized TclInvalidateStringRep() */ @@ -2419,7 +2419,7 @@ Tcl_DbNewDoubleObj( Tcl_Obj * Tcl_DbNewDoubleObj( - register double dblValue, /* Double used to initialize the object. */ + double dblValue, /* Double used to initialize the object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for @@ -2449,8 +2449,8 @@ Tcl_DbNewDoubleObj( void Tcl_SetDoubleObj( - register Tcl_Obj *objPtr, /* Object whose internal rep to init. */ - register double dblValue) /* Double used to set the object's value. */ + Tcl_Obj *objPtr, /* Object whose internal rep to init. */ + double dblValue) /* Double used to set the object's value. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetDoubleObj"); @@ -2482,8 +2482,8 @@ Tcl_SetDoubleObj( int Tcl_GetDoubleFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - register Tcl_Obj *objPtr, /* The object from which to get a double. */ - register double *dblPtr) /* Place to store resulting double. */ + Tcl_Obj *objPtr, /* The object from which to get a double. */ + double *dblPtr) /* Place to store resulting double. */ { do { if (objPtr->typePtr == &tclDoubleType) { @@ -2537,7 +2537,7 @@ Tcl_GetDoubleFromObj( static int SetDoubleFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - register Tcl_Obj *objPtr) /* The object to convert. */ + Tcl_Obj *objPtr) /* The object to convert. */ { return TclParseNumber(interp, objPtr, "floating-point number", NULL, -1, NULL, 0); @@ -2566,7 +2566,7 @@ SetDoubleFromAny( static void UpdateStringOfDouble( - register Tcl_Obj *objPtr) /* Double obj with string rep to update. */ + Tcl_Obj *objPtr) /* Double obj with string rep to update. */ { char *dst = Tcl_InitStringRep(objPtr, NULL, TCL_DOUBLE_SPACE); @@ -2612,7 +2612,7 @@ UpdateStringOfDouble( Tcl_Obj * Tcl_NewIntObj( - register int intValue) /* Int used to initialize the new object. */ + int intValue) /* Int used to initialize the new object. */ { return Tcl_DbNewWideIntObj((long)intValue, "unknown", 0); } @@ -2621,9 +2621,9 @@ Tcl_NewIntObj( Tcl_Obj * Tcl_NewIntObj( - register int intValue) /* Int used to initialize the new object. */ + int intValue) /* Int used to initialize the new object. */ { - register Tcl_Obj *objPtr; + Tcl_Obj *objPtr; TclNewIntObj(objPtr, intValue); return objPtr; @@ -2652,8 +2652,8 @@ Tcl_NewIntObj( #undef Tcl_SetIntObj void Tcl_SetIntObj( - register Tcl_Obj *objPtr, /* Object whose internal rep to init. */ - register int intValue) /* Integer used to set object's value. */ + Tcl_Obj *objPtr, /* Object whose internal rep to init. */ + int intValue) /* Integer used to set object's value. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetIntObj"); @@ -2692,8 +2692,8 @@ Tcl_SetIntObj( int Tcl_GetIntFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - register Tcl_Obj *objPtr, /* The object from which to get a int. */ - register int *intPtr) /* Place to store resulting int. */ + Tcl_Obj *objPtr, /* The object from which to get a int. */ + int *intPtr) /* Place to store resulting int. */ { #if (LONG_MAX == INT_MAX) return TclGetLongFromObj(interp, objPtr, (long *) intPtr); @@ -2763,7 +2763,7 @@ SetIntFromAny( static void UpdateStringOfInt( - register Tcl_Obj *objPtr) /* Int object whose string rep to update. */ + Tcl_Obj *objPtr) /* Int object whose string rep to update. */ { char *dst = Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE); @@ -2775,7 +2775,7 @@ UpdateStringOfInt( #if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG) static void UpdateStringOfOldInt( - register Tcl_Obj *objPtr) /* Int object whose string rep to update. */ + Tcl_Obj *objPtr) /* Int object whose string rep to update. */ { char *dst = Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE); @@ -2821,7 +2821,7 @@ UpdateStringOfOldInt( Tcl_Obj * Tcl_NewLongObj( - register long longValue) /* Long integer used to initialize the + long longValue) /* Long integer used to initialize the * new object. */ { return Tcl_DbNewWideIntObj(longValue, "unknown", 0); @@ -2831,10 +2831,10 @@ Tcl_NewLongObj( Tcl_Obj * Tcl_NewLongObj( - register long longValue) /* Long integer used to initialize the + long longValue) /* Long integer used to initialize the * new object. */ { - register Tcl_Obj *objPtr; + Tcl_Obj *objPtr; TclNewIntObj(objPtr, longValue); return objPtr; @@ -2880,14 +2880,14 @@ Tcl_NewLongObj( Tcl_Obj * Tcl_DbNewLongObj( - register long longValue, /* Long integer used to initialize the new + long longValue, /* Long integer used to initialize the new * object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { - register Tcl_Obj *objPtr; + Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); /* Optimized TclInvalidateStringRep */ @@ -2902,7 +2902,7 @@ Tcl_DbNewLongObj( Tcl_Obj * Tcl_DbNewLongObj( - register long longValue, /* Long integer used to initialize the new + long longValue, /* Long integer used to initialize the new * object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ @@ -2936,8 +2936,8 @@ Tcl_DbNewLongObj( #undef Tcl_SetLongObj void Tcl_SetLongObj( - register Tcl_Obj *objPtr, /* Object whose internal rep to init. */ - register long longValue) /* Long integer used to initialize the + Tcl_Obj *objPtr, /* Object whose internal rep to init. */ + long longValue) /* Long integer used to initialize the * object's value. */ { if (Tcl_IsShared(objPtr)) { @@ -2972,8 +2972,8 @@ Tcl_SetLongObj( int Tcl_GetLongFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - register Tcl_Obj *objPtr, /* The object from which to get a long. */ - register long *longPtr) /* Place to store resulting long. */ + Tcl_Obj *objPtr, /* The object from which to get a long. */ + long *longPtr) /* Place to store resulting long. */ { do { #ifdef TCL_WIDE_INT_IS_LONG @@ -3086,7 +3086,7 @@ Tcl_GetLongFromObj( Tcl_Obj * Tcl_NewWideIntObj( - register Tcl_WideInt wideValue) + Tcl_WideInt wideValue) /* Wide integer used to initialize the new * object. */ { @@ -3097,11 +3097,11 @@ Tcl_NewWideIntObj( Tcl_Obj * Tcl_NewWideIntObj( - register Tcl_WideInt wideValue) + Tcl_WideInt wideValue) /* Wide integer used to initialize the new * object. */ { - register Tcl_Obj *objPtr; + Tcl_Obj *objPtr; TclNewObj(objPtr); TclSetIntObj(objPtr, wideValue); @@ -3145,7 +3145,7 @@ Tcl_NewWideIntObj( Tcl_Obj * Tcl_DbNewWideIntObj( - register Tcl_WideInt wideValue, + Tcl_WideInt wideValue, /* Wide integer used to initialize the new * object. */ const char *file, /* The name of the source file calling this @@ -3153,7 +3153,7 @@ Tcl_DbNewWideIntObj( int line) /* Line number in the source file; used for * debugging. */ { - register Tcl_Obj *objPtr; + Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); TclSetIntObj(objPtr, wideValue); @@ -3164,7 +3164,7 @@ Tcl_DbNewWideIntObj( Tcl_Obj * Tcl_DbNewWideIntObj( - register Tcl_WideInt wideValue, + Tcl_WideInt wideValue, /* Long integer used to initialize the new * object. */ const char *file, /* The name of the source file calling this @@ -3196,8 +3196,8 @@ Tcl_DbNewWideIntObj( void Tcl_SetWideIntObj( - register Tcl_Obj *objPtr, /* Object w. internal rep to init. */ - register Tcl_WideInt wideValue) + Tcl_Obj *objPtr, /* Object w. internal rep to init. */ + Tcl_WideInt wideValue) /* Wide integer used to initialize the * object's value. */ { @@ -3232,8 +3232,8 @@ Tcl_SetWideIntObj( int Tcl_GetWideIntFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - register Tcl_Obj *objPtr, /* Object from which to get a wide int. */ - register Tcl_WideInt *wideIntPtr) + Tcl_Obj *objPtr, /* Object from which to get a wide int. */ + Tcl_WideInt *wideIntPtr) /* Place to store resulting long. */ { do { @@ -3925,7 +3925,7 @@ Tcl_IsShared( void Tcl_DbIncrRefCount( - register Tcl_Obj *objPtr, /* The object we are registering a reference + Tcl_Obj *objPtr, /* The object we are registering a reference * to. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ @@ -3988,7 +3988,7 @@ Tcl_DbIncrRefCount( void Tcl_DbDecrRefCount( - register Tcl_Obj *objPtr, /* The object we are releasing a reference + Tcl_Obj *objPtr, /* The object we are releasing a reference * to. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ @@ -4054,7 +4054,7 @@ Tcl_DbDecrRefCount( int Tcl_DbIsShared( - register Tcl_Obj *objPtr, /* The object to test for being shared. */ + Tcl_Obj *objPtr, /* The object to test for being shared. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for @@ -4126,7 +4126,7 @@ Tcl_DbIsShared( void Tcl_InitObjHashTable( - register Tcl_HashTable *tablePtr) + Tcl_HashTable *tablePtr) /* Pointer to table record, which is supplied * by the caller. */ { @@ -4189,8 +4189,8 @@ TclCompareObjKeys( { Tcl_Obj *objPtr1 = keyPtr; Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue; - register const char *p1, *p2; - register size_t l1, l2; + const char *p1, *p2; + size_t l1, l2; /* * If the object pointers are the same then they match. @@ -4347,13 +4347,13 @@ Tcl_Command Tcl_GetCommandFromObj( Tcl_Interp *interp, /* The interpreter in which to resolve the * command and to report errors. */ - register Tcl_Obj *objPtr) /* The object containing the command's name. + Tcl_Obj *objPtr) /* The object containing the command's name. * If the name starts with "::", will be * looked up in global namespace. Else, looked * up first in the current namespace, then in * global namespace. */ { - register ResolvedCmdName *resPtr; + ResolvedCmdName *resPtr; /* * Get the internal representation, converting to a command type if @@ -4376,12 +4376,12 @@ Tcl_GetCommandFromObj( resPtr = objPtr->internalRep.twoPtrValue.ptr1; if (objPtr->typePtr == &tclCmdNameType) { - register Command *cmdPtr = resPtr->cmdPtr; + Command *cmdPtr = resPtr->cmdPtr; if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch) && (interp == cmdPtr->nsPtr->interp) && !(cmdPtr->nsPtr->flags & NS_DYING)) { - register Namespace *refNsPtr = (Namespace *) + Namespace *refNsPtr = (Namespace *) TclGetCurrentNamespace(interp); if ((resPtr->refNsPtr == NULL) @@ -4483,12 +4483,12 @@ void TclSetCmdNameObj( Tcl_Interp *interp, /* Points to interpreter containing command * that should be cached in objPtr. */ - register Tcl_Obj *objPtr, /* Points to Tcl object to be changed to a + Tcl_Obj *objPtr, /* Points to Tcl object to be changed to a * CmdName object. */ Command *cmdPtr) /* Points to Command structure that the * CmdName object should refer to. */ { - register ResolvedCmdName *resPtr; + ResolvedCmdName *resPtr; if (objPtr->typePtr == &tclCmdNameType) { resPtr = objPtr->internalRep.twoPtrValue.ptr1; @@ -4523,10 +4523,10 @@ TclSetCmdNameObj( static void FreeCmdNameInternalRep( - register Tcl_Obj *objPtr) /* CmdName object with internal + Tcl_Obj *objPtr) /* CmdName object with internal * representation to free. */ { - register ResolvedCmdName *resPtr = objPtr->internalRep.twoPtrValue.ptr1; + ResolvedCmdName *resPtr = objPtr->internalRep.twoPtrValue.ptr1; /* * Decrement the reference count of the ResolvedCmdName structure. If @@ -4571,9 +4571,9 @@ FreeCmdNameInternalRep( static void DupCmdNameInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ - register Tcl_Obj *copyPtr) /* Object with internal rep to set. */ + Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { - register ResolvedCmdName *resPtr = srcPtr->internalRep.twoPtrValue.ptr1; + ResolvedCmdName *resPtr = srcPtr->internalRep.twoPtrValue.ptr1; copyPtr->internalRep.twoPtrValue.ptr1 = resPtr; copyPtr->internalRep.twoPtrValue.ptr2 = NULL; @@ -4605,11 +4605,11 @@ DupCmdNameInternalRep( static int SetCmdNameFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - register Tcl_Obj *objPtr) /* The object to convert. */ + Tcl_Obj *objPtr) /* The object to convert. */ { const char *name; - register Command *cmdPtr; - register ResolvedCmdName *resPtr; + Command *cmdPtr; + ResolvedCmdName *resPtr; if (interp == NULL) { return TCL_ERROR; diff --git a/generic/tclParse.c b/generic/tclParse.c index 164905a..4cd335b 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -195,19 +195,19 @@ Tcl_ParseCommand( * NULL, then no error message is provided. */ const char *start, /* First character of string containing one or * more Tcl commands. */ - register int numBytes, /* Total number of bytes in string. If < 0, + int numBytes, /* Total number of bytes in string. If < 0, * the script consists of all bytes up to the * first null character. */ int nested, /* Non-zero means this is a nested command: * close bracket should be considered a * command terminator. If zero, then close * bracket has no special meaning. */ - register Tcl_Parse *parsePtr) + Tcl_Parse *parsePtr) /* Structure to fill in with information about * the parsed command; any previous * information in the structure is ignored. */ { - register const char *src; /* Points to current character in the + const char *src; /* Points to current character in the * command. */ char type; /* Result returned by CHAR_TYPE(*src). */ Tcl_Token *tokenPtr; /* Pointer to token being filled in. */ @@ -620,14 +620,14 @@ TclIsBareword( static int ParseWhiteSpace( const char *src, /* First character to parse. */ - register int numBytes, /* Max number of bytes to scan. */ + int numBytes, /* Max number of bytes to scan. */ int *incompletePtr, /* Set this boolean memory to true if parsing * indicates an incomplete command. */ char *typePtr) /* Points to location to store character type * of character that ends run of whitespace */ { - register char type = TYPE_NORMAL; - register const char *p = src; + char type = TYPE_NORMAL; + const char *p = src; while (1) { while (numBytes && ((type = CHAR_TYPE(*p)) & TYPE_SPACE)) { @@ -729,7 +729,7 @@ TclParseHex( * conversion is to be written. */ { int result = 0; - register const char *p = src; + const char *p = src; while (numBytes--) { unsigned char digit = UCHAR(*p); @@ -787,7 +787,7 @@ TclParseBackslash( * written. At most TCL_UTF_MAX bytes will be * written there. */ { - register const char *p = src+1; + const char *p = src+1; Tcl_UniChar unichar = 0; int result; int count; @@ -967,12 +967,12 @@ TclParseBackslash( static int ParseComment( const char *src, /* First character to parse. */ - register int numBytes, /* Max number of bytes to scan. */ + int numBytes, /* Max number of bytes to scan. */ Tcl_Parse *parsePtr) /* Information about parse in progress. * Updated if parsing indicates an incomplete * command. */ { - register const char *p = src; + const char *p = src; int incomplete = parsePtr->incomplete; while (numBytes) { @@ -1039,8 +1039,8 @@ ParseComment( static int ParseTokens( - register const char *src, /* First character to parse. */ - register int numBytes, /* Max number of bytes to scan. */ + const char *src, /* First character to parse. */ + int numBytes, /* Max number of bytes to scan. */ int mask, /* Specifies when to stop parsing. The parse * stops at the first unquoted character whose * CHAR_TYPE contains any of the bits in @@ -1318,7 +1318,7 @@ Tcl_ParseVarName( * NULL, then no error message is provided. */ const char *start, /* Start of variable substitution string. * First character must be "$". */ - register int numBytes, /* Total number of bytes in string. If < 0, + int numBytes, /* Total number of bytes in string. If < 0, * the string consists of all bytes up to the * first null character. */ Tcl_Parse *parsePtr, /* Structure to fill in with information about @@ -1329,7 +1329,7 @@ Tcl_ParseVarName( * reinitialize it. */ { Tcl_Token *tokenPtr; - register const char *src; + const char *src; int varIndex; unsigned array; @@ -1511,13 +1511,13 @@ Tcl_ParseVarName( const char * Tcl_ParseVar( Tcl_Interp *interp, /* Context for looking up variable. */ - register const char *start, /* Start of variable substitution. First + const char *start, /* Start of variable substitution. First * character must be "$". */ const char **termPtr) /* If non-NULL, points to word to fill in with * character just after last one in the * variable specifier. */ { - register Tcl_Obj *objPtr; + Tcl_Obj *objPtr; int code; Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse)); @@ -1596,10 +1596,10 @@ Tcl_ParseBraces( * NULL, then no error message is provided. */ const char *start, /* Start of string enclosed in braces. The * first character must be {'. */ - register int numBytes, /* Total number of bytes in string. If < 0, + int numBytes, /* Total number of bytes in string. If < 0, * the string consists of all bytes up to the * first null character. */ - register Tcl_Parse *parsePtr, + Tcl_Parse *parsePtr, /* Structure to fill in with information about * the string. */ int append, /* Non-zero means append tokens to existing @@ -1612,7 +1612,7 @@ Tcl_ParseBraces( * successful. */ { Tcl_Token *tokenPtr; - register const char *src; + const char *src; int startIndex, level, length; if ((numBytes == 0) || (start == NULL)) { @@ -1738,7 +1738,7 @@ Tcl_ParseBraces( */ { - register int openBrace = 0; + int openBrace = 0; while (--src > start) { switch (*src) { @@ -1798,10 +1798,10 @@ Tcl_ParseQuotedString( * NULL, then no error message is provided. */ const char *start, /* Start of the quoted string. The first * character must be '"'. */ - register int numBytes, /* Total number of bytes in string. If < 0, + int numBytes, /* Total number of bytes in string. If < 0, * the string consists of all bytes up to the * first null character. */ - register Tcl_Parse *parsePtr, + Tcl_Parse *parsePtr, /* Structure to fill in with information about * the string. */ int append, /* Non-zero means append tokens to existing diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 3703aaf..79a997e 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -2501,7 +2501,7 @@ DupFsPathInternalRep( static void UpdateStringOfFsPath( - register Tcl_Obj *pathPtr) /* path obj with string rep to update. */ + Tcl_Obj *pathPtr) /* path obj with string rep to update. */ { FsPath *fsPathPtr = PATHOBJ(pathPtr); int cwdLen; diff --git a/generic/tclPipe.c b/generic/tclPipe.c index 63fd2fa..34b75f7 100644 --- a/generic/tclPipe.c +++ b/generic/tclPipe.c @@ -183,7 +183,7 @@ Tcl_DetachPids( * array pointed to by pidPtr. */ Tcl_Pid *pidPtr) /* Array of pids to detach. */ { - register Detached *detPtr; + Detached *detPtr; int i; Tcl_MutexLock(&pipeMutex); @@ -219,7 +219,7 @@ Tcl_DetachPids( void Tcl_ReapDetachedProcs(void) { - register Detached *detPtr; + Detached *detPtr; Detached *nextPtr, *prevPtr; int status, code; diff --git a/generic/tclProc.c b/generic/tclProc.c index afa00ee..e82f249 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -157,7 +157,7 @@ Tcl_ProcObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; Proc *procPtr; const char *procName; const char *simpleName, *procArgs, *procBody; @@ -405,9 +405,9 @@ TclCreateProc( { Interp *iPtr = (Interp *) interp; - register Proc *procPtr = NULL; + Proc *procPtr = NULL; int i, result, numArgs; - register CompiledLocal *localPtr = NULL; + CompiledLocal *localPtr = NULL; Tcl_Obj **argArray; int precompiled = 0; @@ -761,7 +761,7 @@ TclObjGetFrame( CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if * global frame indicated). */ { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; int curLevel, level, result; const Tcl_ObjIntRep *irPtr; const char *name = NULL; @@ -898,7 +898,7 @@ TclNRUplevelObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; CmdFrame *invoker = NULL; int word = 0; int result; @@ -1038,7 +1038,7 @@ ProcWrongNumArgs( int skip) { CallFrame *framePtr = ((Interp *)interp)->varFramePtr; - register Proc *procPtr = framePtr->procPtr; + Proc *procPtr = framePtr->procPtr; int localCt = procPtr->numCompiledLocals, numArgs, i; Tcl_Obj **desiredObjs; const char *final = NULL; @@ -1063,7 +1063,7 @@ ProcWrongNumArgs( Tcl_IncrRefCount(desiredObjs[0]); if (localCt > 0) { - register Var *defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt); + Var *defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt); for (i=1 ; i<=numArgs ; i++, defPtr++) { Tcl_Obj *argObj; @@ -1254,7 +1254,7 @@ InitResolvedLocals( resVarInfo = localPtr->resolveInfo; if (resVarInfo && resVarInfo->fetchProc) { - register Var *resolvedVarPtr = (Var *) + Var *resolvedVarPtr = (Var *) resVarInfo->fetchProc(interp, resVarInfo); if (resolvedVarPtr) { @@ -1277,7 +1277,7 @@ TclFreeLocalCache( Tcl_Obj **namePtrPtr = &localCachePtr->varName0; for (i = 0; i < localCachePtr->numVars; i++, namePtrPtr++) { - register Tcl_Obj *objPtr = *namePtrPtr; + Tcl_Obj *objPtr = *namePtrPtr; if (objPtr) { /* TclReleaseLiteral calls Tcl_DecrRefCount for us */ @@ -1363,16 +1363,16 @@ InitLocalCache( static int InitArgsAndLocals( - register Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp,/* Interpreter in which procedure was * invoked. */ Tcl_Obj *procNameObj, /* Procedure name for error reporting. */ int skip) /* Number of initial arguments to be skipped, * i.e., words in the "command name". */ { CallFrame *framePtr = ((Interp *)interp)->varFramePtr; - register Proc *procPtr = framePtr->procPtr; + Proc *procPtr = framePtr->procPtr; ByteCode *codePtr; - register Var *varPtr, *defPtr; + Var *varPtr, *defPtr; int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax; Tcl_Obj *const *argObjs; @@ -1530,7 +1530,7 @@ int TclPushProcCallFrame( ClientData clientData, /* Record describing procedure to be * interpreted. */ - register Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp,/* Interpreter in which procedure was * invoked. */ int objc, /* Count of number of arguments to this * procedure. */ @@ -1622,7 +1622,7 @@ int TclObjInterpProc( ClientData clientData, /* Record describing procedure to be * interpreted. */ - register Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp,/* Interpreter in which procedure was * invoked. */ int objc, /* Count of number of arguments to this * procedure. */ @@ -1639,7 +1639,7 @@ int TclNRInterpProc( ClientData clientData, /* Record describing procedure to be * interpreted. */ - register Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp,/* Interpreter in which procedure was * invoked. */ int objc, /* Count of number of arguments to this * procedure. */ @@ -1674,7 +1674,7 @@ TclNRInterpProc( int TclNRInterpProcCore( - register Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp,/* Interpreter in which procedure was * invoked. */ Tcl_Obj *procNameObj, /* Procedure name for error reporting. */ int skip, /* Number of initial arguments to be skipped, @@ -1683,7 +1683,7 @@ TclNRInterpProcCore( * results of the overall procedure. */ { Interp *iPtr = (Interp *) interp; - register Proc *procPtr = iPtr->varFramePtr->procPtr; + Proc *procPtr = iPtr->varFramePtr->procPtr; int result; CallFrame *freePtr; ByteCode *codePtr; @@ -1700,8 +1700,8 @@ TclNRInterpProcCore( #if defined(TCL_COMPILE_DEBUG) if (tclTraceExec >= 1) { - register CallFrame *framePtr = iPtr->varFramePtr; - register int i; + CallFrame *framePtr = iPtr->varFramePtr; + int i; if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) { fprintf(stdout, "Calling lambda "); @@ -2119,9 +2119,9 @@ TclProcDeleteProc( void TclProcCleanupProc( - register Proc *procPtr) /* Procedure to be deleted. */ + Proc *procPtr) /* Procedure to be deleted. */ { - register CompiledLocal *localPtr; + CompiledLocal *localPtr; Tcl_Obj *bodyPtr = procPtr->bodyPtr; Tcl_Obj *defPtr; Tcl_ResolvedVarInfo *resVarInfo; @@ -2370,7 +2370,7 @@ ProcBodyFree( static void DupLambdaInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ - register Tcl_Obj *copyPtr) /* Object with internal rep to set. */ + Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { Proc *procPtr; Tcl_Obj *nsObjPtr; @@ -2385,7 +2385,7 @@ DupLambdaInternalRep( static void FreeLambdaInternalRep( - register Tcl_Obj *objPtr) /* CmdName object with internal representation + Tcl_Obj *objPtr) /* CmdName object with internal representation * to free. */ { Proc *procPtr; @@ -2403,7 +2403,7 @@ FreeLambdaInternalRep( static int SetLambdaFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - register Tcl_Obj *objPtr) /* The object to convert. */ + Tcl_Obj *objPtr) /* The object to convert. */ { Interp *iPtr = (Interp *) interp; const char *name; diff --git a/generic/tclResult.c b/generic/tclResult.c index 4d14f01..40c452e 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -414,14 +414,14 @@ void Tcl_SetResult( Tcl_Interp *interp, /* Interpreter with which to associate the * return value. */ - register char *result, /* Value to be returned. If NULL, the result + char *result, /* Value to be returned. If NULL, the result * is set to an empty string. */ Tcl_FreeProc *freeProc) /* Gives information about the string: * TCL_STATIC, TCL_VOLATILE, or the address of * a Tcl_FreeProc such as free. */ { Interp *iPtr = (Interp *) interp; - register Tcl_FreeProc *oldFreeProc = iPtr->freeProc; + Tcl_FreeProc *oldFreeProc = iPtr->freeProc; char *oldResult = iPtr->result; if (result == NULL) { @@ -484,7 +484,7 @@ Tcl_SetResult( const char * Tcl_GetStringResult( - register Tcl_Interp *interp)/* Interpreter whose result to return. */ + Tcl_Interp *interp)/* Interpreter whose result to return. */ { Interp *iPtr = (Interp *) interp; /* @@ -523,11 +523,11 @@ void Tcl_SetObjResult( Tcl_Interp *interp, /* Interpreter with which to associate the * return object value. */ - register Tcl_Obj *objPtr) /* Tcl object to be returned. If NULL, the obj + Tcl_Obj *objPtr) /* Tcl object to be returned. If NULL, the obj * result is made an empty string object. */ { - register Interp *iPtr = (Interp *) interp; - register Tcl_Obj *oldObjResult = iPtr->objResultPtr; + Interp *iPtr = (Interp *) interp; + Tcl_Obj *oldObjResult = iPtr->objResultPtr; iPtr->objResultPtr = objPtr; Tcl_IncrRefCount(objPtr); /* since interp result is a reference */ @@ -582,7 +582,7 @@ Tcl_Obj * Tcl_GetObjResult( Tcl_Interp *interp) /* Interpreter whose result to return. */ { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; #ifndef TCL_NO_DEPRECATED Tcl_Obj *objResultPtr; int length; @@ -879,9 +879,9 @@ SetupAppendBuffer( void Tcl_FreeResult( - register Tcl_Interp *interp)/* Interpreter for which to free result. */ + Tcl_Interp *interp)/* Interpreter for which to free result. */ { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; #ifndef TCL_NO_DEPRECATED if (iPtr->freeProc != NULL) { @@ -918,9 +918,9 @@ Tcl_FreeResult( void Tcl_ResetResult( - register Tcl_Interp *interp)/* Interpreter for which to clear result. */ + Tcl_Interp *interp)/* Interpreter for which to clear result. */ { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; ResetObjResult(iPtr); #ifndef TCL_NO_DEPRECATED @@ -983,10 +983,10 @@ Tcl_ResetResult( static void ResetObjResult( - register Interp *iPtr) /* Points to the interpreter whose result + Interp *iPtr) /* Points to the interpreter whose result * object should be reset. */ { - register Tcl_Obj *objResultPtr = iPtr->objResultPtr; + Tcl_Obj *objResultPtr = iPtr->objResultPtr; if (Tcl_IsShared(objResultPtr)) { TclDecrRefCount(objResultPtr); diff --git a/generic/tclTest.c b/generic/tclTest.c index 4eb8519..067d4a0 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -5176,7 +5176,7 @@ TestbytestringObjCmd( static int TestsetCmd( void *data, /* Additional flags for Get/SetVar2. */ - register Tcl_Interp *interp,/* Current interpreter. */ + Tcl_Interp *interp,/* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { @@ -5208,7 +5208,7 @@ TestsetCmd( static int Testset2Cmd( void *data, /* Additional flags for Get/SetVar2. */ - register Tcl_Interp *interp,/* Current interpreter. */ + Tcl_Interp *interp,/* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { @@ -5259,7 +5259,7 @@ Testset2Cmd( static int TestsaveresultCmd( void *dummy, /* Not used. */ - register Tcl_Interp *interp,/* Current interpreter. */ + Tcl_Interp *interp,/* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { @@ -5390,7 +5390,7 @@ TestsaveresultFree( static int TestmainthreadCmd( void *dummy, /* Not used. */ - register Tcl_Interp *interp,/* Current interpreter. */ + Tcl_Interp *interp,/* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { @@ -5451,7 +5451,7 @@ MainLoop(void) static int TestsetmainloopCmd( void *dummy, /* Not used. */ - register Tcl_Interp *interp,/* Current interpreter. */ + Tcl_Interp *interp,/* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { @@ -5480,7 +5480,7 @@ TestsetmainloopCmd( static int TestexitmainloopCmd( void *dummy, /* Not used. */ - register Tcl_Interp *interp,/* Current interpreter. */ + Tcl_Interp *interp,/* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index c9e4a6f..82a8c45 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -53,7 +53,7 @@ static int TeststringobjCmd(ClientData dummy, Tcl_Interp *interp, static void VarPtrDeleteProc(ClientData clientData, Tcl_Interp *interp) { - register int i; + int i; Tcl_Obj **varPtr = (Tcl_Obj **) clientData; for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) { if (varPtr[i]) Tcl_DecrRefCount(varPtr[i]); @@ -91,7 +91,7 @@ int TclObjTest_Init( Tcl_Interp *interp) { - register int i; + int i; /* * An array of Tcl_Obj pointers used in the commands that operate on or get * the values of Tcl object-valued variables. varPtr[i] is the i-th variable's diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c index 3f1abc2..60d7b0c 100644 --- a/generic/tclThreadAlloc.c +++ b/generic/tclThreadAlloc.c @@ -248,7 +248,7 @@ TclFreeAllocCache( { Cache *cachePtr = arg; Cache **nextPtrPtr; - register unsigned int bucket; + unsigned int bucket; /* * Flush blocks. @@ -305,7 +305,7 @@ TclpAlloc( { Cache *cachePtr; Block *blockPtr; - register int bucket; + int bucket; size_t size; #ifndef __LP64__ @@ -537,8 +537,8 @@ TclpRealloc( Tcl_Obj * TclThreadAllocObj(void) { - register Cache *cachePtr; - register Tcl_Obj *objPtr; + Cache *cachePtr; + Tcl_Obj *objPtr; GETCACHE(cachePtr); @@ -548,7 +548,7 @@ TclThreadAllocObj(void) */ if (cachePtr->numObjects == 0) { - register int numMove; + int numMove; Tcl_MutexLock(objLockPtr); numMove = sharedPtr->numObjects; @@ -709,7 +709,7 @@ MoveObjs( Cache *toPtr, int numMove) { - register Tcl_Obj *objPtr = fromPtr->firstObjPtr; + Tcl_Obj *objPtr = fromPtr->firstObjPtr; Tcl_Obj *fromFirstObjPtr = objPtr; toPtr->numObjects += numMove; @@ -810,7 +810,7 @@ Block2Ptr( int bucket, unsigned int reqSize) { - register void *ptr; + void *ptr; blockPtr->magicNum1 = blockPtr->magicNum2 = MAGIC; blockPtr->sourceBucket = bucket; @@ -826,7 +826,7 @@ static Block * Ptr2Block( char *ptr) { - register Block *blockPtr; + Block *blockPtr; blockPtr = (((Block *) ptr) - 1); if (blockPtr->magicNum1 != MAGIC || blockPtr->magicNum2 != MAGIC) { @@ -960,8 +960,8 @@ GetBlocks( Cache *cachePtr, int bucket) { - register Block *blockPtr; - register int n; + Block *blockPtr; + int n; /* * First, atttempt to move blocks from the shared cache. Note the @@ -1006,7 +1006,7 @@ GetBlocks( } if (cachePtr->buckets[bucket].numFree == 0) { - register size_t size; + size_t size; /* * If no blocks could be moved from shared, first look for a larger diff --git a/generic/tclTimer.c b/generic/tclTimer.c index ea80320..934b329 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -217,7 +217,7 @@ TimerExitProc( Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL); if (tsdPtr != NULL) { - register TimerHandler *timerHandlerPtr; + TimerHandler *timerHandlerPtr; timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; while (timerHandlerPtr != NULL) { @@ -294,7 +294,7 @@ TclCreateAbsoluteTimerHandler( Tcl_TimerProc *proc, ClientData clientData) { - register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr; + TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr; ThreadSpecificData *tsdPtr = InitTimer(); timerHandlerPtr = ckalloc(sizeof(TimerHandler)); @@ -355,7 +355,7 @@ Tcl_DeleteTimerHandler( Tcl_TimerToken token) /* Result previously returned by * Tcl_DeleteTimerHandler. */ { - register TimerHandler *timerHandlerPtr, *prevPtr; + TimerHandler *timerHandlerPtr, *prevPtr; ThreadSpecificData *tsdPtr = InitTimer(); if (token == NULL) { @@ -621,7 +621,7 @@ Tcl_DoWhenIdle( Tcl_IdleProc *proc, /* Function to invoke. */ ClientData clientData) /* Arbitrary value to pass to proc. */ { - register IdleHandler *idlePtr; + IdleHandler *idlePtr; Tcl_Time blockTime; ThreadSpecificData *tsdPtr = InitTimer(); @@ -665,7 +665,7 @@ Tcl_CancelIdleCall( Tcl_IdleProc *proc, /* Function that was previously registered. */ ClientData clientData) /* Arbitrary value to pass to proc. */ { - register IdleHandler *idlePtr, *prevPtr; + IdleHandler *idlePtr, *prevPtr; IdleHandler *nextPtr; ThreadSpecificData *tsdPtr = InitTimer(); diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 1a6d459..ca246fb 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -136,7 +136,7 @@ static int StringTraceProc(ClientData clientData, static void StringTraceDeleteProc(ClientData clientData); static void DisposeTraceResult(int flags, char *result); static int TraceVarEx(Tcl_Interp *interp, const char *part1, - const char *part2, register VarTrace *tracePtr); + const char *part2, VarTrace *tracePtr); /* * The following structure holds the client data for string-based @@ -1049,7 +1049,7 @@ Tcl_CommandTraceInfo( * call will return the first trace. */ { Command *cmdPtr; - register CommandTrace *tracePtr; + CommandTrace *tracePtr; cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL, TCL_LEAVE_ERR_MSG); @@ -1114,7 +1114,7 @@ Tcl_TraceCommand( ClientData clientData) /* Arbitrary argument to pass to proc. */ { Command *cmdPtr; - register CommandTrace *tracePtr; + CommandTrace *tracePtr; cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL, TCL_LEAVE_ERR_MSG); @@ -1177,7 +1177,7 @@ Tcl_UntraceCommand( Tcl_CommandTraceProc *proc, /* Function assocated with trace. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { - register CommandTrace *tracePtr; + CommandTrace *tracePtr; CommandTrace *prevPtr; Command *cmdPtr; Interp *iPtr = (Interp *) interp; @@ -1672,13 +1672,13 @@ TclCheckInterpTraces( static int CallTraceFunction( Tcl_Interp *interp, /* The current interpreter. */ - register Trace *tracePtr, /* Describes the trace function to call. */ + Trace *tracePtr, /* Describes the trace function to call. */ Command *cmdPtr, /* Points to command's Command struct. */ const char *command, /* Points to the first character of the * command's source before substitutions. */ int numChars, /* The number of characters in the command's * source. */ - register int objc, /* Number of arguments for the command. */ + int objc, /* Number of arguments for the command. */ Tcl_Obj *const objv[]) /* Pointers to Tcl_Obj of each argument. */ { Interp *iPtr = (Interp *) interp; @@ -1920,7 +1920,7 @@ TraceExecutionProc( if ((flags & TCL_TRACE_ENTER_EXEC) && (tcmdPtr->stepTrace == NULL) && (tcmdPtr->flags & (TCL_TRACE_ENTER_DURING_EXEC | TCL_TRACE_LEAVE_DURING_EXEC))) { - register unsigned len = strlen(command) + 1; + unsigned len = strlen(command) + 1; tcmdPtr->startLevel = level; tcmdPtr->startCmd = ckalloc(len); @@ -2065,7 +2065,7 @@ TraceVarProc( } } if (destroy && result != NULL) { - register Tcl_Obj *errMsgObj = (Tcl_Obj *) result; + Tcl_Obj *errMsgObj = (Tcl_Obj *) result; Tcl_DecrRefCount(errMsgObj); result = NULL; @@ -2142,8 +2142,8 @@ Tcl_CreateObjTrace( Tcl_CmdObjTraceDeleteProc *delProc) /* Function to call when trace is deleted */ { - register Trace *tracePtr; - register Interp *iPtr = (Interp *) interp; + Trace *tracePtr; + Interp *iPtr = (Interp *) interp; /* * Test if this trace allows inline compilation of commands. @@ -2342,7 +2342,7 @@ Tcl_DeleteTrace( { Interp *iPtr = (Interp *) interp; Trace *prevPtr, *tracePtr = (Trace *) trace; - register Trace **tracePtr2 = &iPtr->tracePtr; + Trace **tracePtr2 = &iPtr->tracePtr; ActiveInterpTrace *activePtr; /* @@ -2534,7 +2534,7 @@ TclCheckArrayTraces( int TclObjCallVarTraces( Interp *iPtr, /* Interpreter containing variable. */ - register Var *arrayPtr, /* Pointer to array variable that contains the + Var *arrayPtr, /* Pointer to array variable that contains the * variable, or NULL if the variable isn't an * element of an array. */ Var *varPtr, /* Variable whose traces are to be invoked. */ @@ -2568,7 +2568,7 @@ TclObjCallVarTraces( int TclCallVarTraces( Interp *iPtr, /* Interpreter containing variable. */ - register Var *arrayPtr, /* Pointer to array variable that contains the + Var *arrayPtr, /* Pointer to array variable that contains the * variable, or NULL if the variable isn't an * element of an array. */ Var *varPtr, /* Variable whose traces are to be invoked. */ @@ -2581,7 +2581,7 @@ TclCallVarTraces( * error, then leave an error message and * stack trace information in *iPTr. */ { - register VarTrace *tracePtr; + VarTrace *tracePtr; ActiveVarTrace active; char *result; const char *openParen, *p; @@ -2911,7 +2911,7 @@ Tcl_UntraceVar2( Tcl_VarTraceProc *proc, /* Function assocated with trace. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { - register VarTrace *tracePtr; + VarTrace *tracePtr; VarTrace *prevPtr, *nextPtr; Var *varPtr, *arrayPtr; Interp *iPtr = (Interp *) interp; @@ -3103,7 +3103,7 @@ Tcl_VarTraceInfo2( hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr); if (hPtr) { - register VarTrace *tracePtr = Tcl_GetHashValue(hPtr); + VarTrace *tracePtr = Tcl_GetHashValue(hPtr); if (prevClientData != NULL) { for (; tracePtr != NULL; tracePtr = tracePtr->nextPtr) { @@ -3201,7 +3201,7 @@ Tcl_TraceVar2( * invoked upon varName. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { - register VarTrace *tracePtr; + VarTrace *tracePtr; int result; tracePtr = ckalloc(sizeof(VarTrace)); @@ -3246,7 +3246,7 @@ TraceVarEx( const char *part2, /* Name of element within array; NULL means * trace applies to scalar variable or array * as-a-whole. */ - register VarTrace *tracePtr)/* Structure containing flags, traceProc and + VarTrace *tracePtr)/* Structure containing flags, traceProc and * clientData fields. Others should be left * blank. Will be ckfree()d (eventually) if * this function returns TCL_OK, and up to diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 86d1913..542a82a 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -352,8 +352,8 @@ static const unsigned short cp1252[32] = { int Tcl_UtfToUniChar( - register const char *src, /* The UTF-8 string. */ - register Tcl_UniChar *chPtr)/* Filled with the Tcl_UniChar represented by + const char *src, /* The UTF-8 string. */ + Tcl_UniChar *chPtr)/* Filled with the Tcl_UniChar represented by * the UTF-8 string. */ { Tcl_UniChar byte; @@ -731,12 +731,12 @@ Tcl_UtfCharComplete( int Tcl_NumUtfChars( - register const char *src, /* The UTF-8 string to measure. */ + const char *src, /* The UTF-8 string to measure. */ int length) /* The length of the string in bytes, or -1 * for strlen(string). */ { Tcl_UniChar ch = 0; - register int i = 0; + int i = 0; /* * The separate implementations are faster. @@ -752,7 +752,7 @@ Tcl_NumUtfChars( } if (i < 0) i = INT_MAX; /* Bug [2738427] */ } else { - register const char *endPtr = src + length - 4; + const char *endPtr = src + length - 4; while (src < endPtr) { src += TclUtfToUniChar(src, &ch); @@ -968,8 +968,8 @@ Tcl_UtfPrev( int Tcl_UniCharAtIndex( - register const char *src, /* The UTF-8 string to dereference. */ - register int index) /* The position of the desired character. */ + const char *src, /* The UTF-8 string to dereference. */ + int index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; int fullchar = 0; @@ -1016,8 +1016,8 @@ Tcl_UniCharAtIndex( const char * Tcl_UtfAtIndex( - register const char *src, /* The UTF-8 string. */ - register int index) /* The position of the desired character. */ + const char *src, /* The UTF-8 string. */ + int index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; int len = 0; @@ -1323,7 +1323,7 @@ TclpUtfNcmp2( * fine in the strcmp manner. */ - register int result = 0; + int result = 0; for ( ; numBytes != 0; numBytes--, cs++, ct++) { if (*cs != *ct) { diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 4387c75..8bf3eb3 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -943,8 +943,8 @@ Tcl_SplitList( int Tcl_ScanElement( - register const char *src, /* String to convert to list element. */ - register int *flagPtr) /* Where to store information to guide + const char *src, /* String to convert to list element. */ + int *flagPtr) /* Where to store information to guide * Tcl_ConvertCountedElement. */ { return Tcl_ScanCountedElement(src, -1, flagPtr); @@ -1323,9 +1323,9 @@ TclScanElement( int Tcl_ConvertElement( - register const char *src, /* Source information for list element. */ - register char *dst, /* Place to put list-ified element. */ - register int flags) /* Flags produced by Tcl_ScanElement. */ + const char *src, /* Source information for list element. */ + char *dst, /* Place to put list-ified element. */ + int flags) /* Flags produced by Tcl_ScanElement. */ { return Tcl_ConvertCountedElement(src, -1, dst, flags); } @@ -1353,7 +1353,7 @@ Tcl_ConvertElement( int Tcl_ConvertCountedElement( - register const char *src, /* Source information for list element. */ + const char *src, /* Source information for list element. */ int length, /* Number of bytes in src, or -1. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ @@ -1386,7 +1386,7 @@ Tcl_ConvertCountedElement( int TclConvertElement( - register const char *src, /* Source information for list element. */ + const char *src, /* Source information for list element. */ int length, /* Number of bytes in src, or -1. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ @@ -4192,7 +4192,7 @@ TclCheckBadOctal( * errors. */ const char *value) /* String to check. */ { - register const char *p = value; + const char *p = value; /* * A frequent mistake is invalid octal values due to an unwanted leading diff --git a/generic/tclVar.c b/generic/tclVar.c index e8ebd3c..4849839 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -532,7 +532,7 @@ TclLookupVar( Var * TclObjLookupVar( Tcl_Interp *interp, /* Interpreter to use for lookup. */ - register Tcl_Obj *part1Ptr, /* If part2 isn't NULL, this is the name of an + Tcl_Obj *part1Ptr, /* If part2 isn't NULL, this is the name of an * array. Otherwise, this is a full variable * name that could include a parenthesized * array element. */ @@ -605,7 +605,7 @@ TclObjLookupVarEx( { Interp *iPtr = (Interp *) interp; CallFrame *varFramePtr = iPtr->varFramePtr; - register Var *varPtr; /* Points to the variable's in-frame Var + Var *varPtr; /* Points to the variable's in-frame Var * structure. */ const char *errMsg = NULL; int index, parsed = 0; @@ -984,7 +984,7 @@ TclLookupSimpleVar( int localLen; for (i=0 ; ikey.objPtr; - register const char *p1, *p2; - register int l1, l2; + const char *p1, *p2; + int l1, l2; /* * If the object pointers are the same then they match. diff --git a/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c index 7c65088..bc5998e 100644 --- a/macosx/tclMacOSXFCmd.c +++ b/macosx/tclMacOSXFCmd.c @@ -689,7 +689,7 @@ SetOSTypeFromAny( static void UpdateStringOfOSType( - register Tcl_Obj *objPtr) /* OSType object whose string rep to + Tcl_Obj *objPtr) /* OSType object whose string rep to * update. */ { const int size = TCL_UTF_MAX * 4; diff --git a/unix/tclLoadAix.c b/unix/tclLoadAix.c index e5d9729..fea9494 100644 --- a/unix/tclLoadAix.c +++ b/unix/tclLoadAix.c @@ -98,7 +98,7 @@ dlopen( const char *path, int mode) { - register ModulePtr mp; + ModulePtr mp; static void *mainModule; /* @@ -191,7 +191,7 @@ dlopen( */ if (mode & RTLD_GLOBAL) { - register ModulePtr mp1; + ModulePtr mp1; for (mp1 = mp->next; mp1; mp1 = mp1->next) { if (loadbind(0, mp1->entry, mp->entry) == -1) { @@ -243,7 +243,7 @@ static void caterr( char *s) { - register char *p = s; + char *p = s; while (*p >= '0' && *p <= '9') { p++; @@ -282,9 +282,9 @@ dlsym( void *handle, const char *symbol) { - register ModulePtr mp = (ModulePtr)handle; - register ExportPtr ep; - register int i; + ModulePtr mp = (ModulePtr)handle; + ExportPtr ep; + int i; /* * Could speed up the search, but I assume that one assigns the result to @@ -317,9 +317,9 @@ int dlclose( void *handle) { - register ModulePtr mp = (ModulePtr)handle; + ModulePtr mp = (ModulePtr)handle; int result; - register ModulePtr mp1; + ModulePtr mp1; if (--mp->refCnt > 0) { return 0; @@ -343,8 +343,8 @@ dlclose( } if (mp->exports) { - register ExportPtr ep; - register int i; + ExportPtr ep; + int i; for (ep = mp->exports, i = mp->nExports; i; i--, ep++) { if (ep->name) { free(ep->name); diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c index aa25c6b..1ed3f59 100644 --- a/unix/tclUnixCompat.c +++ b/unix/tclUnixCompat.c @@ -685,8 +685,8 @@ CopyGrp( char *buf, int buflen) { - register char *p = buf; - register int copied, len = 0; + char *p = buf; + int copied, len = 0; /* * Copy username. diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index 90b5384..004fbff 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -1001,7 +1001,7 @@ TclpFindVariable( * searches). */ { int i, result = -1; - register const char *env, *p1, *p2; + const char *env, *p1, *p2; Tcl_DString envString; Tcl_DStringInit(&envString); diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index 60340b0..35eca8d 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -844,7 +844,7 @@ Tcl_Mutex * TclpNewAllocMutex(void) { AllocMutex *lockPtr; - register PMutex *plockPtr; + PMutex *plockPtr; lockPtr = malloc(sizeof(AllocMutex)); if (lockPtr == NULL) { diff --git a/win/tclWinInit.c b/win/tclWinInit.c index f4c6e06..e82d74b 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -628,7 +628,7 @@ TclpFindVariable( * searches). */ { int i, length, result = -1; - register const char *env, *p1, *p2; + const char *env, *p1, *p2; char *envUpper, *nameUpper; Tcl_DString envString; -- cgit v0.12 From 400a5524e5f12e96c47dc1613835765f4a9f0271 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 1 Aug 2019 08:02:38 +0000 Subject: Attempt to fix [https://core.tcl-lang.org/tk/tktview?name=a179564826|a179564826]: Tk 8.6: prevent issues when encountering non-BMP Unicode characters --- generic/tclUtf.c | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 4b70f96..0a275d7 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -71,7 +71,7 @@ static const unsigned char totalBytes[256] = { #if TCL_UTF_MAX > 3 4,4,4,4,4, #else - 1,1,1,1,1, + 3,3,3,3,3, /* Tcl_UtfCharComplete() only checks TCL_UTF_MAX bytes */ #endif 1,1,1,1,1,1,1,1,1,1,1 }; @@ -314,7 +314,7 @@ Tcl_UtfToUniChar( * characters representing themselves. */ -#if TCL_UTF_MAX == 4 +#if TCL_UTF_MAX <= 4 /* If *chPtr contains a high surrogate (produced by a previous * Tcl_UtfToUniChar() call) and the next 3 bytes are UTF-8 continuation * bytes, then we must produce a follow-up low surrogate. We only @@ -364,13 +364,12 @@ Tcl_UtfToUniChar( * represents itself. */ } -#if TCL_UTF_MAX > 3 else if (byte < 0xF8) { if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80) && ((src[3] & 0xC0) == 0x80)) { /* * Four-byte-character lead byte followed by three trail bytes. */ -#if TCL_UTF_MAX == 4 +#if TCL_UTF_MAX <= 4 Tcl_UniChar high = (((byte & 0x07) << 8) | ((src[1] & 0x3F) << 2) | ((src[2] & 0x3F) >> 4)) - 0x40; if (high >= 0x400) { @@ -394,7 +393,6 @@ Tcl_UtfToUniChar( * represents itself. */ } -#endif *chPtr = byte; return 1; -- cgit v0.12 From 1f5fec57ef0dee8325f4bd297688038ff1ac80d9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 12 Aug 2019 17:10:26 +0000 Subject: Test windows native build --- .travis.yml | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 9798220..861cc86 100644 --- a/.travis.yml +++ b/.travis.yml @@ -246,10 +246,22 @@ matrix: script: - cmd.exe /C 'vcvarsall.bat x64 && nmake OPTS=symbols,msvcrt,threads -f makefile.vc all tcltest' - cmd.exe /C 'vcvarsall.bat x64 && nmake OPTS=symbols,msvcrt,threads -f makefile.vc test' + - name: "Windows/GCC/Shared 1" + os: windows + compiler: gcc + env: + - BUILD_DIR=win + - CFGOPT="--enable-64bit" + - name: "Windows/GCC/Shared 2" + os: windows + compiler: gcc + env: + - BUILD_DIR=win + - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit" before_install: - cd ${BUILD_DIR} install: - - ./configure ${CFGOPT} --prefix=$HOME + - ./configure ${CFGOPT} --prefix=$HOME || (cat config.log && exit 1) before_script: - export ERROR_ON_FAILURES=1 script: -- cgit v0.12 From 1378468fa10e03791463f6d0a3268efbc4882a0f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 12 Aug 2019 18:53:55 +0000 Subject: Forgot "choko install make" --- .travis.yml | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/.travis.yml b/.travis.yml index 861cc86..3c1af6e 100644 --- a/.travis.yml +++ b/.travis.yml @@ -252,12 +252,18 @@ matrix: env: - BUILD_DIR=win - CFGOPT="--enable-64bit" + before_install: + - choco install make + - cd ${BUILD_DIR} - name: "Windows/GCC/Shared 2" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit" + before_install: + - choco install make + - cd ${BUILD_DIR} before_install: - cd ${BUILD_DIR} install: -- cgit v0.12 From c9376306301e578615cfee52d2121f78cb31a225 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 14 Aug 2019 06:42:58 +0000 Subject: Remove "register" keyword in various places. Also add some type-casts to help C++ compatibility. --- compat/fake-rfc2553.c | 3 ++- compat/gettod.c | 3 ++- compat/mkstemp.c | 13 +++++++------ compat/opendir.c | 12 ++++++------ compat/strstr.c | 4 ++-- compat/strtol.c | 2 +- compat/strtoul.c | 6 +++--- compat/waitpid.c | 2 +- generic/regcomp.c | 2 +- generic/regexec.c | 3 +-- generic/tclDate.c | 10 +++++----- generic/tclGetDate.y | 10 +++++----- generic/tclTrace.c | 2 +- macosx/tclMacOSXFCmd.c | 4 ++-- 14 files changed, 39 insertions(+), 37 deletions(-) diff --git a/compat/fake-rfc2553.c b/compat/fake-rfc2553.c index c8e69400..29e2b56 100644 --- a/compat/fake-rfc2553.c +++ b/compat/fake-rfc2553.c @@ -73,6 +73,7 @@ int fake_getnameinfo(const struct sockaddr *sa, size_t salen, char *host, struct sockaddr_in *sin = (struct sockaddr_in *)sa; struct hostent *hp; char tmpserv[16]; + (void)salen; if (sa->sa_family != AF_UNSPEC && sa->sa_family != AF_INET) return (EAI_FAMILY); @@ -153,7 +154,7 @@ addrinfo *malloc_ai(int port, u_long addr, const struct addrinfo *hints) { struct addrinfo *ai; - ai = malloc(sizeof(*ai) + sizeof(struct sockaddr_in)); + ai = (struct addrinfo *)malloc(sizeof(*ai) + sizeof(struct sockaddr_in)); if (ai == NULL) return (NULL); diff --git a/compat/gettod.c b/compat/gettod.c index ca20cf8..f6651d4 100644 --- a/compat/gettod.c +++ b/compat/gettod.c @@ -21,10 +21,11 @@ gettimeofday( struct timezone *tz) { struct timeb t; + (void)tz; ftime(&t); tp->tv_sec = t.time; - tp->tv_usec = t. millitm * 1000; + tp->tv_usec = t.millitm * 1000; return 0; } diff --git a/compat/mkstemp.c b/compat/mkstemp.c index 1a44dfa..feccfbb 100644 --- a/compat/mkstemp.c +++ b/compat/mkstemp.c @@ -13,6 +13,7 @@ #include #include #include +#include /* *---------------------------------------------------------------------- @@ -32,19 +33,19 @@ int mkstemp( - char *template) /* Template for filename. */ + char *tmpl) /* Template for filename. */ { static const char alphanumerics[] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"; - register char *a, *b; + char *a, *b; int fd, count, alphanumericsLen = strlen(alphanumerics); /* == 62 */ - a = template + strlen(template); - while (a > template && *(a-1) == 'X') { + a = tmpl + strlen(tmpl); + while (a > tmpl && *(a-1) == 'X') { a--; } - if (a == template) { + if (a == tmpl) { errno = ENOENT; return -1; } @@ -71,7 +72,7 @@ mkstemp( * Template is now realized; try to open (with correct options). */ - fd = open(template, O_RDWR|O_CREAT|O_EXCL, 0600); + fd = open(tmpl, O_RDWR|O_CREAT|O_EXCL, 0600); } while (fd == -1 && errno == EEXIST && --count > 0); return fd; diff --git a/compat/opendir.c b/compat/opendir.c index 7a49566..25a7ada 100644 --- a/compat/opendir.c +++ b/compat/opendir.c @@ -20,9 +20,9 @@ DIR * opendir( char *name) { - register DIR *dirp; - register int fd; - char *myname; + DIR *dirp; + int fd; + const char *myname; myname = ((*name == '\0') ? "." : name); if ((fd = open(myname, 0, 0)) == -1) { @@ -65,9 +65,9 @@ struct olddirect { struct dirent * readdir( - register DIR *dirp) + DIR *dirp) { - register struct olddirect *dp; + struct olddirect *dp; static struct dirent dir; for (;;) { @@ -101,7 +101,7 @@ readdir( void closedir( - register DIR *dirp) + DIR *dirp) { close(dirp->dd_fd); dirp->dd_fd = -1; diff --git a/compat/strstr.c b/compat/strstr.c index e3b9b8d..206dca9 100644 --- a/compat/strstr.c +++ b/compat/strstr.c @@ -36,10 +36,10 @@ char * strstr( - register char *string, /* String to search. */ + char *string, /* String to search. */ char *substring) /* Substring to try to find in string. */ { - register char *a, *b; + char *a, *b; /* * First scan quickly through the two strings looking for a diff --git a/compat/strtol.c b/compat/strtol.c index b7f6919..22cc1eb 100644 --- a/compat/strtol.c +++ b/compat/strtol.c @@ -45,7 +45,7 @@ strtol( * hex, "0" means octal, anything else means * decimal. */ { - register const char *p; + const char *p; long result; /* diff --git a/compat/strtoul.c b/compat/strtoul.c index e37eb05..bf16f7a 100644 --- a/compat/strtoul.c +++ b/compat/strtoul.c @@ -62,9 +62,9 @@ strtoul( * hex, "0" means octal, anything else means * decimal. */ { - register const char *p; - register unsigned long int result = 0; - register unsigned digit; + const char *p; + unsigned long int result = 0; + unsigned digit; int anyDigits = 0; int negative=0; int overflow=0; diff --git a/compat/waitpid.c b/compat/waitpid.c index d4473a8..626d210 100644 --- a/compat/waitpid.c +++ b/compat/waitpid.c @@ -70,7 +70,7 @@ waitpid( int options) /* OR'ed combination of WNOHANG and * WUNTRACED. */ { - register WaitInfo *waitPtr, *prevPtr; + WaitInfo *waitPtr, *prevPtr; pid_t result; WAIT_STATUS_TYPE status; diff --git a/generic/regcomp.c b/generic/regcomp.c index 49b024f..093cb95 100644 --- a/generic/regcomp.c +++ b/generic/regcomp.c @@ -512,7 +512,7 @@ freev( struct vars *v, int err) { - register int ret; + int ret; if (v->re != NULL) { rfree(v->re); diff --git a/generic/regexec.c b/generic/regexec.c index 1a3e114..24c4eac 100644 --- a/generic/regexec.c +++ b/generic/regexec.c @@ -91,7 +91,6 @@ struct smalldfa { struct sset *outsarea[FEWSTATES*2 * FEWCOLORS]; struct arcp incarea[FEWSTATES*2 * FEWCOLORS]; }; -#define DOMALLOC ((struct smalldfa *)NULL) /* force malloc */ /* * Internal variables, bundled for easy passing around. @@ -299,7 +298,7 @@ getsubdfa(struct vars * v, struct subre * t) { if (v->subdfas[t->id] == NULL) { - v->subdfas[t->id] = newDFA(v, &t->cnfa, &v->g->cmap, DOMALLOC); + v->subdfas[t->id] = newDFA(v, &t->cnfa, &v->g->cmap, NULL); if (ISERR()) return NULL; } diff --git a/generic/tclDate.c b/generic/tclDate.c index bf8a150..fb4f3cf 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -2549,9 +2549,9 @@ LookupWord( YYSTYPE* yylvalPtr, char *buff) { - register char *p; - register char *q; - register const TABLE *tp; + char *p; + char *q; + const TABLE *tp; int i, abbrev; /* @@ -2674,8 +2674,8 @@ TclDatelex( YYLTYPE* location, DateInfo *info) { - register char c; - register char *p; + char c; + char *p; char buff[20]; int Count; diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index d67c32a..3b6134c 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -765,9 +765,9 @@ LookupWord( YYSTYPE* yylvalPtr, char *buff) { - register char *p; - register char *q; - register const TABLE *tp; + char *p; + char *q; + const TABLE *tp; int i, abbrev; /* @@ -890,8 +890,8 @@ TclDatelex( YYLTYPE* location, DateInfo *info) { - register char c; - register char *p; + char c; + char *p; char buff[20]; int Count; diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 1a6d459..27746b4 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -1920,7 +1920,7 @@ TraceExecutionProc( if ((flags & TCL_TRACE_ENTER_EXEC) && (tcmdPtr->stepTrace == NULL) && (tcmdPtr->flags & (TCL_TRACE_ENTER_DURING_EXEC | TCL_TRACE_LEAVE_DURING_EXEC))) { - register unsigned len = strlen(command) + 1; + size_t len = strlen(command) + 1; tcmdPtr->startLevel = level; tcmdPtr->startCmd = ckalloc(len); diff --git a/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c index 7c65088..6ff60aa 100644 --- a/macosx/tclMacOSXFCmd.c +++ b/macosx/tclMacOSXFCmd.c @@ -347,7 +347,7 @@ TclMacOSXSetFileAttribute( Tcl_DStringAppend(&ds, native, -1); Tcl_DStringAppend(&ds, _PATH_RSRCFORKSPEC, -1); - result = truncate(Tcl_DStringValue(&ds), (off_t)0); + result = truncate(Tcl_DStringValue(&ds), 0); if (result != 0) { /* * truncate() on a valid resource fork path may fail with a @@ -689,7 +689,7 @@ SetOSTypeFromAny( static void UpdateStringOfOSType( - register Tcl_Obj *objPtr) /* OSType object whose string rep to + Tcl_Obj *objPtr) /* OSType object whose string rep to * update. */ { const int size = TCL_UTF_MAX * 4; -- cgit v0.12 From 831e40a351cc05df4e170c4606d090020bd80b3a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 14 Aug 2019 19:23:13 +0000 Subject: Minor simplification in test-suite: Because "teststringobj maxchars" has the effect that the value is converted to Unicode for, we don't need a separate function "teststringobj getunicode" for that. So, merge the two functions to one. --- generic/tclTestObj.c | 14 ++++---------- tests/stringObj.test | 4 ++-- tests/utf.test | 16 ++++++++-------- 3 files changed, 14 insertions(+), 20 deletions(-) diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index c9e4a6f..3f2aecd 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -1178,8 +1178,8 @@ TeststringobjCmd( Tcl_Obj **varPtr; static const char *const options[] = { "append", "appendstrings", "get", "get2", "length", "length2", - "set", "set2", "setlength", "maxchars", "getunicode", - "appendself", "appendself2", NULL + "set", "set2", "setlength", "maxchars", "appendself", + "appendself2", NULL }; if (objc < 3) { @@ -1344,13 +1344,7 @@ TeststringobjCmd( } Tcl_SetIntObj(Tcl_GetObjResult(interp), length); break; - case 10: /* getunicode */ - if (objc != 3) { - goto wrongNumArgs; - } - Tcl_GetUnicode(varPtr[varIndex]); - break; - case 11: /* appendself */ + case 10: /* appendself */ if (objc != 4) { goto wrongNumArgs; } @@ -1381,7 +1375,7 @@ TeststringobjCmd( Tcl_AppendToObj(varPtr[varIndex], string + i, length - i); Tcl_SetObjResult(interp, varPtr[varIndex]); break; - case 12: /* appendself2 */ + case 11: /* appendself2 */ if (objc != 4) { goto wrongNumArgs; } diff --git a/tests/stringObj.test b/tests/stringObj.test index a78b5f8..bda7285 100644 --- a/tests/stringObj.test +++ b/tests/stringObj.test @@ -439,9 +439,9 @@ test stringObj-13.8 {Tcl_GetCharLength with identity nulls} {testobj testbytestr test stringObj-14.1 {Tcl_SetObjLength on pure unicode object} testobj { teststringobj set 1 foo - teststringobj getunicode 1 + teststringobj maxchars 1 teststringobj append 1 bar -1 - teststringobj getunicode 1 + teststringobj maxchars 1 teststringobj append 1 bar -1 teststringobj setlength 1 0 teststringobj append 1 bar -1 diff --git a/tests/utf.test b/tests/utf.test index dc1a435..f75d19e 100644 --- a/tests/utf.test +++ b/tests/utf.test @@ -471,8 +471,8 @@ test utf-25.1 {Tcl_UniCharNcasecmp} -constraints teststringobj \ -body { teststringobj set 1 a teststringobj set 2 b - teststringobj getunicode 1 - teststringobj getunicode 2 + teststringobj maxchars 1 + teststringobj maxchars 2 string compare -nocase [teststringobj get 1] [teststringobj get 2] } \ -cleanup { @@ -486,8 +486,8 @@ test utf-25.2 {Tcl_UniCharNcasecmp} -constraints teststringobj \ -body { teststringobj set 1 b teststringobj set 2 a - teststringobj getunicode 1 - teststringobj getunicode 2 + teststringobj maxchars 1 + teststringobj maxchars 2 string compare -nocase [teststringobj get 1] [teststringobj get 2] } \ -cleanup { @@ -501,8 +501,8 @@ test utf-25.3 {Tcl_UniCharNcasecmp} -constraints teststringobj \ -body { teststringobj set 1 B teststringobj set 2 a - teststringobj getunicode 1 - teststringobj getunicode 2 + teststringobj maxchars 1 + teststringobj maxchars 2 string compare -nocase [teststringobj get 1] [teststringobj get 2] } \ -cleanup { @@ -517,8 +517,8 @@ test utf-25.4 {Tcl_UniCharNcasecmp} -constraints teststringobj \ -body { teststringobj set 1 aBcB teststringobj set 2 abca - teststringobj getunicode 1 - teststringobj getunicode 2 + teststringobj maxchars 1 + teststringobj maxchars 2 string compare -nocase [teststringobj get 1] [teststringobj get 2] } \ -cleanup { -- cgit v0.12 From e2bb5b8ee8deb36456ac402ccd936253734af65d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 15 Aug 2019 07:04:56 +0000 Subject: Fix [6de8494984]: Tcl_CreateCommandChannel() documentation bug --- doc/OpenFileChnl.3 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/OpenFileChnl.3 b/doc/OpenFileChnl.3 index 582ff4b..82851da 100644 --- a/doc/OpenFileChnl.3 +++ b/doc/OpenFileChnl.3 @@ -277,7 +277,7 @@ If an error occurs while opening the channel, \fBTcl_OpenCommandChannel\fR returns NULL and records a POSIX error code that can be retrieved with \fBTcl_GetErrno\fR. In addition, \fBTcl_OpenCommandChannel\fR leaves an error message in -the interpreter's result if \fIinterp\fR is not NULL. +the interpreter's result. \fIinterp\fR cannot be NULL. .PP The newly created channel is not registered in the supplied interpreter; to register it, use \fBTcl_RegisterChannel\fR, described below. -- cgit v0.12 From 7c060e830b6573d92fab57f30437f7d969164079 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 15 Aug 2019 15:31:43 +0000 Subject: Make zipfsFilesystem static (as the name - not starting with Tcl - suggests). Also remove one unneeded MODULE_SCOPE, as TclZipfs_Init is already declared in tclInt.h --- generic/tclZipfs.c | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 6a568fe..d842289 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -399,9 +399,7 @@ static int ZipChannelWrite(void *instanceData, * Define the ZIP filesystem dispatch table. */ -MODULE_SCOPE const Tcl_Filesystem zipfsFilesystem; - -const Tcl_Filesystem zipfsFilesystem = { +static const Tcl_Filesystem zipfsFilesystem = { "zipfs", sizeof(Tcl_Filesystem), TCL_FILESYSTEM_VERSION_2, @@ -4729,7 +4727,7 @@ ZipFSLoadFile( *------------------------------------------------------------------------- */ -MODULE_SCOPE int +int TclZipfs_Init( Tcl_Interp *interp) /* Current interpreter. */ { -- cgit v0.12 From 5c9efe088bb217b4c6d62cce13415b6e7e14a19b Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 19 Aug 2019 18:34:44 +0000 Subject: win/Makefile.in: partially cherry-picked 8.6th version (and normalized to be more similar to all major versions now), fixed VPATH (TOP_DIR/ROOT_DIR) compiling from chocolatey or git-bash (closes [40d5ff2a0e]), added tcltest-helpers, etc. --- win/Makefile.in | 243 +++++++++++++++++++++++++++++--------------------------- 1 file changed, 126 insertions(+), 117 deletions(-) diff --git a/win/Makefile.in b/win/Makefile.in index b3be22d..bf05961 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -83,6 +83,11 @@ CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@ #CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE) CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ -D_ATL_XP_TARGETING +# To compile without backward compatibility and deprecated code uncomment the +# following +NO_DEPRECATED_FLAGS = +#NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED + # To enable compilation debugging reverse the comment characters on one of the # following lines. COMPILE_DEBUG_FLAGS = @@ -94,10 +99,11 @@ MAN2TCLFLAGS = @MAN2TCLFLAGS@ SRC_DIR = @srcdir@ ROOT_DIR = @srcdir@/.. -GENERIC_DIR = @srcdir@/../generic -TOMMATH_DIR = @srcdir@/../libtommath -WIN_DIR = @srcdir@ -COMPAT_DIR = @srcdir@/../compat +TOP_DIR = $(shell cd @srcdir@/..; pwd -W || pwd -P) +GENERIC_DIR = $(TOP_DIR)/generic +TOMMATH_DIR = $(TOP_DIR)/libtommath +WIN_DIR = $(TOP_DIR)/win +COMPAT_DIR = $(TOP_DIR)/compat # Converts a POSIX path to a Windows native path. CYGPATH = @CYGPATH@ @@ -111,6 +117,7 @@ GENERIC_DIR_NATIVE = $(shell $(CYGPATH) '$(GENERIC_DIR)') TOMMATH_DIR_NATIVE = $(shell $(CYGPATH) '$(TOMMATH_DIR)') WIN_DIR_NATIVE = $(shell $(CYGPATH) '$(WIN_DIR)') ROOT_DIR_NATIVE = $(shell $(CYGPATH) '$(ROOT_DIR)') +ROOT_DIR_WIN_NATIVE = $(shell cd '$(ROOT_DIR)' ; pwd -W || pwd -P) #GENERIC_DIR_NATIVE = $(GENERIC_DIR) #TOMMATH_DIR_NATIVE = $(TOMMATH_DIR) #WIN_DIR_NATIVE = $(WIN_DIR) @@ -118,7 +125,7 @@ ROOT_DIR_NATIVE = $(shell $(CYGPATH) '$(ROOT_DIR)') # Fully qualify library path so that `make test` # does not depend on the current directory. -LIBRARY_DIR1 = $(shell cd '$(ROOT_DIR_NATIVE)/library' ; pwd) +LIBRARY_DIR1 = $(shell cd '$(ROOT_DIR_NATIVE)/library' ; pwd -P) LIBRARY_DIR = $(shell $(CYGPATH) '$(LIBRARY_DIR1)') DLLSUFFIX = @DLLSUFFIX@ LIBSUFFIX = @LIBSUFFIX@ @@ -135,31 +142,29 @@ TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@ TCL_DLL_FILE = @TCL_DLL_FILE@ TCL_LIB_FILE = @TCL_LIB_FILE@ DDE_DLL_FILE = tcldde$(DDEVER)${DLLSUFFIX} -DDE_LIB_FILE = tcldde$(DDEVER)${LIBSUFFIX} +DDE_LIB_FILE = @LIBPREFIX@tcldde$(DDEVER)${LIBSUFFIX} REG_DLL_FILE = tclreg$(REGVER)${DLLSUFFIX} -REG_LIB_FILE = tclreg$(REGVER)${LIBSUFFIX} -PIPE_DLL_FILE = tclpip$(VER)${DLLSUFFIX} - -SHARED_LIBRARIES = $(TCL_DLL_FILE) $(TCL_STUB_LIB_FILE) \ - $(DDE_DLL_FILE) $(REG_DLL_FILE) $(PIPE_DLL_FILE) -STATIC_LIBRARIES = $(TCL_LIB_FILE) $(REG_LIB_FILE) $(DDE_LIB_FILE) - -# To compile without backward compatibility and deprecated code -# uncomment the following -NO_DEPRECATED_FLAGS = -#NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED +REG_LIB_FILE = @LIBPREFIX@tclreg$(REGVER)${LIBSUFFIX} +TEST_EXE_FILE = tcltest${EXESUFFIX} +TEST_LIB_FILE = @LIBPREFIX@tcltest$(VER)${LIBSUFFIX} +TEST_LOAD_PRMS = package ifneeded dde 1.4.1 [list load [file normalize ${DDE_DLL_FILE}] dde];\ + package ifneeded registry 1.3.3 [list load [file normalize ${REG_DLL_FILE}] registry] +TEST_LOAD_FACILITIES = $(TEST_LOAD_PRMS) -# TCL_EXE is the name of a tclsh executable that is available *BEFORE* running -# make for the first time. Certain build targets (make genstubs) need it to be -# available on the PATH. This executable should *NOT* be required just to do a -# normal build although it can be required to run make dist. -TCL_EXE = tclsh +SHARED_LIBRARIES = $(TCL_DLL_FILE) +STATIC_LIBRARIES = $(TCL_LIB_FILE) TCLSH = tclsh$(VER)${EXESUFFIX} -TCLTEST = tcltest${EXEEXT} CAT32 = cat32$(EXEEXT) MAN2TCL = man2tcl$(EXEEXT) +# For cross-compiled builds, TCL_EXE is the name of a tclsh executable that is +# available *BEFORE* running make for the first time. Certain build targets +# (make genstubs, make install) need it to be available on the PATH. This +# executable should *NOT* be required just to do a normal build although +# it can be required to run make dist. +TCL_EXE = @TCL_EXE@ + @SET_MAKE@ # Setting the VPATH variable to a list of paths will cause the Makefile to @@ -183,7 +188,7 @@ EXEEXT = @EXEEXT@ OBJEXT = @OBJEXT@ STLIB_LD = @STLIB_LD@ SHLIB_LD = @SHLIB_LD@ -SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ $(LIBS) +SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ SHLIB_CFLAGS = @SHLIB_CFLAGS@ SHLIB_SUFFIX = @SHLIB_SUFFIX@ LIBS = @LIBS@ @@ -195,9 +200,9 @@ RM = rm -f COPY = cp CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} \ --I"${GENERIC_DIR_NATIVE}" -DTCL_TOMMATH -DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" \ --I"${WIN_DIR_NATIVE}" ${AC_FLAGS} \ -${COMPILE_DEBUG_FLAGS} ${NO_DEPRECATED_FLAGS} +-I"${GENERIC_DIR_NATIVE}" -DTCL_TOMMATH \ +-DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \ +${AC_FLAGS} ${COMPILE_DEBUG_FLAGS} ${NO_DEPRECATED_FLAGS} CC_OBJNAME = @CC_OBJNAME@ CC_EXENAME = @CC_EXENAME@ @@ -212,8 +217,7 @@ TCLTEST_OBJS = \ tclTestObj.$(OBJEXT) \ tclTestProcBodyObj.$(OBJEXT) \ tclThreadTest.$(OBJEXT) \ - tclWinTest.$(OBJEXT) \ - testMain.$(OBJEXT) + tclWinTest.$(OBJEXT) GENERIC_OBJS = \ regcomp.$(OBJEXT) \ @@ -387,32 +391,49 @@ TCL_DOCS = "$(ROOT_DIR_NATIVE)"/doc/*.[13n] all: binaries libraries doc -tcltest: binaries $(TCLTEST) +# Test-suite helper (can be used to test Tcl from build directory with all expected modules). +# To start from windows shell use: +# > tcltest.cmd -verbose bps -file fileName.test +# or from mingw/msys shell: +# $ ./tcltest -verbose bps -file fileName.test + +tcltest-cmd: + @echo 'Create tcltest.cmd helpers'; + @(\ + echo '@echo off'; \ + echo 'rem set LANG=en_US'; \ + echo 'set BDP=%~dp0'; \ + echo 'set OWD=%CD%'; \ + echo 'cd /d %TEMP%'; \ + echo 'rem "%BDP%\$(TCLSH)" "$(ROOT_DIR_WIN_NATIVE)/tests/all.tcl" %TESTFLAGS% -load "$(TEST_LOAD_FACILITIES)" %*'; \ + echo '"%BDP%\$(TEST_EXE_FILE)" "$(ROOT_DIR_WIN_NATIVE)/tests/all.tcl" %TESTFLAGS% -load "$(TEST_LOAD_PRMS)" %*'; \ + echo 'cd /d %OWD%'; \ + ) > tcltest.cmd; + @(\ + echo '#!/bin/sh'; \ + echo '#LANG=en_US'; \ + echo 'BDP=$$(dirname $$(readlink -f %0))'; \ + echo 'cd /tmp'; \ + echo '#"$$BDP/$(TCLSH)" "$(ROOT_DIR_WIN_NATIVE)/tests/all.tcl" $$TESTFLAGS -load "$(TEST_LOAD_FACILITIES)" "$$@"'; \ + echo '"$$BDP/$(TEST_EXE_FILE)" "$(ROOT_DIR_WIN_NATIVE)/tests/all.tcl" $$TESTFLAGS -load "$(TEST_LOAD_PRMS)" "$$@"'; \ + ) > tcltest.sh; +tcltest.sh: tcltest-cmd +tcltest.cmd: tcltest-cmd + +tcltest: binaries $(TEST_EXE_FILE) tcltest-cmd + +binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ winextensions $(TCLSH) -binaries: @LIBRARIES@ $(TCLSH) +winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE} libraries: doc: -winhelp: $(ROOT_DIR)/tools/man2help.tcl $(MAN2TCL) - TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ - ./$(TCLSH) "$(ROOT_DIR_NATIVE)"/tools/man2help.tcl tcl "$(VER)" $(TCL_DOCS) - hcw /c /e tcl.hpj - -winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE} - -$(MAN2TCL): $(ROOT_DIR)/tools/man2tcl.c - $(CC) $(CFLAGS_OPTIMIZE) $(MAN2TCLFLAGS) -o $(MAN2TCL) "$(ROOT_DIR_NATIVE)"/tools/man2tcl.c - -$(TCLSH): $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(TCLSH_OBJS) tclsh.$(RES) - $(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(LIBS) \ - tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) - @VC_MANIFEST_EMBED_EXE@ - -$(TCLTEST): $(TCL_LIB_FILE) $(TCLTEST_OBJS) $(CAT32) tclsh.$(RES) - $(CC) $(CFLAGS) $(TCLTEST_OBJS) $(TCL_LIB_FILE) $(LIBS) \ +$(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) + $(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) + $(COPY) tclsh.exe.manifest $(TCLSH).manifest @VC_MANIFEST_EMBED_EXE@ cat32.$(OBJEXT): cat.c @@ -430,30 +451,29 @@ ${TCL_STUB_LIB_FILE}: ${STUB_OBJS} @POST_MAKE_LIB@ ${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) - @$(RM) ${TCL_DLL_FILE} + @$(RM) ${TCL_DLL_FILE} $(TCL_LIB_FILE) @MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS) + $(COPY) tclsh.exe.manifest ${TCL_DLL_FILE}.manifest @VC_MANIFEST_EMBED_DLL@ -${TCL_LIB_FILE}: ${TCL_OBJS} +${TCL_LIB_FILE}: ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS} @$(RM) ${TCL_LIB_FILE} - @MAKE_LIB@ ${TCL_OBJS} + @MAKE_LIB@ ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS} @POST_MAKE_LIB@ -${DDE_DLL_FILE}: ${DDE_OBJS} ${TCL_STUB_LIB_FILE} - @$(RM) ${DDE_DLL_FILE} +${DDE_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${DDE_OBJS} @MAKE_DLL@ ${DDE_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) + $(COPY) tclsh.exe.manifest ${DDE_DLL_FILE}.manifest -${DDE_LIB_FILE}: ${DDE_OBJS} ${TCL_LIB_FILE} - @$(RM) ${DDE_LIB_FILE} - @MAKE_LIB@ ${DDE_OBJS} ${TCL_LIB_FILE} - -${REG_DLL_FILE}: ${REG_OBJS} ${TCL_STUB_LIB_FILE} - @$(RM) ${REG_DLL_FILE} +${REG_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${REG_OBJS} @MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) + $(COPY) tclsh.exe.manifest ${REG_DLL_FILE}.manifest -${REG_LIB_FILE}: ${REG_OBJS} ${TCL_LIB_FILE} - @$(RM) ${REG_LIB_FILE} - @MAKE_LIB@ ${REG_OBJS} ${TCL_LIB_FILE} +${TEST_EXE_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS} tclTestMain.${OBJEXT} + @$(RM) ${TEST_EXE_FILE} + $(CC) $(CFLAGS) $(TCLTEST_OBJS) tclTestMain.$(OBJEXT) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ + tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) + $(COPY) tclsh.exe.manifest ${TEST_EXE_FILE}.manifest # PIPE_DLL_FILE is actually an executable, don't build it like a DLL. @@ -470,6 +490,9 @@ ${PIPE_DLL_FILE}: ${PIPE_OBJS} # Special case object targets +tclTestMain.${OBJEXT}: tclAppInit.c + $(CC) -c $(CC_SWITCHES) -DTCL_TEST -DBUILD_tcl $(EXTFLAGS) $(CC_OBJNAME) $(WIN_DIR)/tclAppInit.c + tclWinInit.${OBJEXT}: tclWinInit.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) @@ -480,26 +503,6 @@ tclWinPipe.${OBJEXT}: tclWinPipe.c testMain.${OBJEXT}: tclAppInit.c $(CC) -c $(CC_SWITCHES) -DTCL_TEST @DEPARG@ $(CC_OBJNAME) -tclTest.${OBJEXT}: tclTest.c - $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) - -tclTestObj.${OBJEXT}: tclTestObj.c - $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) - -tclWinTest.${OBJEXT}: tclWinTest.c - $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) - -tclAppInit.${OBJEXT} : tclAppInit.c - $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) - -# The following objects should be built using the stub interfaces - -tclWinReg.${OBJEXT} : tclWinReg.c - $(CC) -c $(CC_SWITCHES) -DUNICODE -D_UNICODE -DUSE_TCL_STUBS @DEPARG@ $(CC_OBJNAME) - -tclWinDde.${OBJEXT} : tclWinDde.c - $(CC) -c $(CC_SWITCHES) -DUNICODE -D_UNICODE -DUSE_TCL_STUBS @DEPARG@ $(CC_OBJNAME) - # TIP #59, embedding of configuration information into the binary library. # # Part of Tcl's configuration information are the paths where it was installed @@ -510,17 +513,17 @@ tclWinDde.${OBJEXT} : tclWinDde.c tclPkgConfig.${OBJEXT}: tclPkgConfig.c $(CC) -c $(CC_SWITCHES) \ - -DCFG_INSTALL_LIBDIR=\"$(LIB_INSTALL_DIR_NATIVE)\" \ - -DCFG_INSTALL_BINDIR=\"$(BIN_INSTALL_DIR_NATIVE)\" \ - -DCFG_INSTALL_SCRDIR=\"$(SCRIPT_INSTALL_DIR_NATIVE)\" \ - -DCFG_INSTALL_INCDIR=\"$(INCLUDE_INSTALL_DIR_NATIVE)\" \ - -DCFG_INSTALL_DOCDIR=\"$(MAN_INSTALL_DIR)\" \ + -DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR_NATIVE)\"" \ + -DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR_NATIVE)\"" \ + -DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR_NATIVE)\"" \ + -DCFG_INSTALL_INCDIR="\"$(INCLUDE_INSTALL_DIR_NATIVE)\"" \ + -DCFG_INSTALL_DOCDIR="\"$(MAN_INSTALL_DIR)\"" \ \ - -DCFG_RUNTIME_LIBDIR=\"$(libdir_native)\" \ - -DCFG_RUNTIME_BINDIR=\"$(bindir_native)\" \ - -DCFG_RUNTIME_SCRDIR=\"$(TCL_LIBRARY_NATIVE)\" \ - -DCFG_RUNTIME_INCDIR=\"$(includedir_native)\" \ - -DCFG_RUNTIME_DOCDIR=\"$(mandir_native)\" \ + -DCFG_RUNTIME_LIBDIR="\"$(libdir_native)\"" \ + -DCFG_RUNTIME_BINDIR="\"$(bindir_native)\"" \ + -DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY_NATIVE)\"" \ + -DCFG_RUNTIME_INCDIR="\"$(includedir_native)\"" \ + -DCFG_RUNTIME_DOCDIR="\"$(mandir_native)\"" \ -DBUILD_tcl \ @DEPARG@ $(CC_OBJNAME) @@ -555,9 +558,9 @@ gendate: # run (and the results checked) after updating to a new release of libtommath. gentommath_h: - $(TCL_EXE) "$(ROOT_DIR_NATIVE)\tools\fix_tommath_h.tcl" \ - "$(TOMMATH_DIR_NATIVE)\tommath.h" \ - > "$(GENERIC_DIR_NATIVE)\tclTomMath.h" + $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/fix_tommath_h.tcl" \ + "$(TOMMATH_DIR_NATIVE)/tommath.h" \ + > "$(GENERIC_DIR_NATIVE)/tclTomMath.h" install: all install-binaries install-libraries install-doc @@ -571,7 +574,7 @@ install-binaries: binaries else true; \ fi; \ done; - @for i in dde$(DDEDOTVER) reg$(REGDOTVER); \ + @for i in dde${DDEDOTVER} reg${REGDOTVER}; \ do \ if [ ! -d $(LIB_INSTALL_DIR)/$$i ] ; then \ echo "Making directory $(LIB_INSTALL_DIR)/$$i"; \ @@ -595,27 +598,27 @@ install-binaries: binaries done @if [ -f $(DDE_DLL_FILE) ]; then \ echo Installing $(DDE_DLL_FILE); \ - $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde$(DDEDOTVER); \ + $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \ $(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \ - $(LIB_INSTALL_DIR)/dde$(DDEDOTVER); \ + $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \ fi @if [ -f $(DDE_LIB_FILE) ]; then \ echo Installing $(DDE_LIB_FILE); \ - $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde$(DDEDOTVER); \ + $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \ fi @if [ -f $(REG_DLL_FILE) ]; then \ echo Installing $(REG_DLL_FILE); \ - $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg$(REGDOTVER); \ + $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \ $(COPY) $(ROOT_DIR)/library/reg/pkgIndex.tcl \ - $(LIB_INSTALL_DIR)/reg$(REGDOTVER); \ + $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \ fi @if [ -f $(REG_LIB_FILE) ]; then \ echo Installing $(REG_LIB_FILE); \ - $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg$(REGDOTVER); \ + $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \ fi install-libraries: libraries install-tzdata install-msgs - @for i in $(prefix)/lib $(INCLUDE_INSTALL_DIR) \ + @for i in "$$($(CYGPATH) $(prefix)/lib)" "$(INCLUDE_INSTALL_DIR)" \ $(SCRIPT_INSTALL_DIR); \ do \ if [ ! -d $$i ] ; then \ @@ -672,14 +675,12 @@ install-libraries: libraries install-tzdata install-msgs install-tzdata: @echo "Installing time zone data" - @TCL_LIBRARY="${LIBRARY_DIR}"; export TCL_LIBRARY; \ - ./$(TCLSH) "$(ROOT_DIR)/tools/installData.tcl" \ + @$(TCL_EXE) "$(ROOT_DIR)/tools/installData.tcl" \ "$(ROOT_DIR)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata" install-msgs: @echo "Installing message catalogs" - @TCL_LIBRARY="${LIBRARY_DIR}"; export TCL_LIBRARY; \ - ./$(TCLSH) "$(ROOT_DIR)/tools/installData.tcl" \ + @$(TCL_EXE) "$(ROOT_DIR)/tools/installData.tcl" \ "$(ROOT_DIR)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs" install-doc: doc @@ -706,17 +707,17 @@ install-private-headers: libraries # tcltest, i.e.: # % make test TESTFLAGS="-verbose bps -file fileName.test" -test: binaries $(TCLTEST) +test: test-tcl test-packages + +test-tcl: binaries $(TCLSH) $(TEST_EXE_FILE) TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ - ./$(TCLTEST) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \ - -load "package ifneeded dde 1.4.1 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ - package ifneeded registry 1.3.3 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32) + ./$(TEST_EXE_FILE) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \ + -load "$(TEST_LOAD_FACILITIES)" -# Useful target to launch a built tcltest with the proper path,... -runtest: binaries $(TCLTEST) +# Useful target to launch a built tclsh with the proper path,... +runtest: binaries $(TCLSH) $(TEST_EXE_FILE) @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ - ./$(TCLTEST) $(TESTFLAGS) -load "package ifneeded dde 1.4.1 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ - package ifneeded registry 1.3.3 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT) + ./$(TEST_EXE_FILE) $(TESTFLAGS) -load "$(TEST_LOAD_FACILITIES)" $(SCRIPT) # This target can be used to run tclsh from the build directory via # `make shell SCRIPT=foo.tcl` @@ -740,7 +741,7 @@ cleanhelp: clean: cleanhelp $(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out - $(RM) $(TCLSH) $(TCLTEST) $(CAT32) + $(RM) $(TCLSH) $(CAT32) $(TEST_EXE_FILE) tcltest.cmd tcltest $(RM) *.pch *.ilk *.pdb distclean: clean @@ -761,9 +762,17 @@ genstubs: $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \ "$(GENERIC_DIR_NATIVE)" \ "$(GENERIC_DIR_NATIVE)/tcl.decls" \ - "$(GENERIC_DIR_NATIVE)/tclInt.decls" \ + "$(GENERIC_DIR_NATIVE)/tclInt.decls" \ "$(GENERIC_DIR_NATIVE)/tclTomMath.decls" +winhelp: $(ROOT_DIR)/tools/man2help.tcl $(MAN2TCL) + TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ + ./$(TCLSH) "$(ROOT_DIR_NATIVE)"/tools/man2help.tcl tcl "$(VER)" $(TCL_DOCS) + hcw /c /e tcl.hpj + +$(MAN2TCL): $(ROOT_DIR)/tools/man2tcl.c + $(CC) $(CFLAGS_OPTIMIZE) $(MAN2TCLFLAGS) -o $(MAN2TCL) "$(ROOT_DIR_NATIVE)"/tools/man2tcl.c + # # The list of all the targets that do not correspond to real files. This stops # 'make' from getting confused when someone makes an error in a rule. -- cgit v0.12 From e3d59c1d523daa93161dc550f773251f3a42b79c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 20 Aug 2019 07:20:07 +0000 Subject: Prevent misleading message: -bash: pwd: -W: invalid option pwd: usage: pwd [-LP]" written to stderr when pwd -W doesn't exist, e.g. on Linux/MacOS/Cygwin or any cross-compile other than Msys2. --- win/Makefile.in | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/win/Makefile.in b/win/Makefile.in index bf05961..b0ddcd7 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -99,7 +99,7 @@ MAN2TCLFLAGS = @MAN2TCLFLAGS@ SRC_DIR = @srcdir@ ROOT_DIR = @srcdir@/.. -TOP_DIR = $(shell cd @srcdir@/..; pwd -W || pwd -P) +TOP_DIR = $(shell cd @srcdir@/..; pwd -W 2>/dev/null || pwd -P) GENERIC_DIR = $(TOP_DIR)/generic TOMMATH_DIR = $(TOP_DIR)/libtommath WIN_DIR = $(TOP_DIR)/win @@ -117,7 +117,7 @@ GENERIC_DIR_NATIVE = $(shell $(CYGPATH) '$(GENERIC_DIR)') TOMMATH_DIR_NATIVE = $(shell $(CYGPATH) '$(TOMMATH_DIR)') WIN_DIR_NATIVE = $(shell $(CYGPATH) '$(WIN_DIR)') ROOT_DIR_NATIVE = $(shell $(CYGPATH) '$(ROOT_DIR)') -ROOT_DIR_WIN_NATIVE = $(shell cd '$(ROOT_DIR)' ; pwd -W || pwd -P) +ROOT_DIR_WIN_NATIVE = $(shell cd '$(ROOT_DIR)' ; pwd -W 2>/dev/null || pwd -P) #GENERIC_DIR_NATIVE = $(GENERIC_DIR) #TOMMATH_DIR_NATIVE = $(TOMMATH_DIR) #WIN_DIR_NATIVE = $(WIN_DIR) -- cgit v0.12 From 3c3f52cca367ded2626bef1917c86d43a998128c Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 20 Aug 2019 08:03:37 +0000 Subject: win/Makefile.in: small amend normalizing test-dependencies --- win/Makefile.in | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/win/Makefile.in b/win/Makefile.in index b0ddcd7..dbe8df2 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -397,7 +397,7 @@ all: binaries libraries doc # or from mingw/msys shell: # $ ./tcltest -verbose bps -file fileName.test -tcltest-cmd: +tcltest.cmd: Makefile @echo 'Create tcltest.cmd helpers'; @(\ echo '@echo off'; \ @@ -417,10 +417,10 @@ tcltest-cmd: echo '#"$$BDP/$(TCLSH)" "$(ROOT_DIR_WIN_NATIVE)/tests/all.tcl" $$TESTFLAGS -load "$(TEST_LOAD_FACILITIES)" "$$@"'; \ echo '"$$BDP/$(TEST_EXE_FILE)" "$(ROOT_DIR_WIN_NATIVE)/tests/all.tcl" $$TESTFLAGS -load "$(TEST_LOAD_PRMS)" "$$@"'; \ ) > tcltest.sh; -tcltest.sh: tcltest-cmd -tcltest.cmd: tcltest-cmd -tcltest: binaries $(TEST_EXE_FILE) tcltest-cmd +tcltest.sh: tcltest.cmd + +tcltest: binaries $(TEST_EXE_FILE) $(CAT32) tcltest.cmd binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ winextensions $(TCLSH) @@ -709,13 +709,13 @@ install-private-headers: libraries test: test-tcl test-packages -test-tcl: binaries $(TCLSH) $(TEST_EXE_FILE) +test-tcl: tcltest TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ ./$(TEST_EXE_FILE) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \ -load "$(TEST_LOAD_FACILITIES)" # Useful target to launch a built tclsh with the proper path,... -runtest: binaries $(TCLSH) $(TEST_EXE_FILE) +runtest: tcltest @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ ./$(TEST_EXE_FILE) $(TESTFLAGS) -load "$(TEST_LOAD_FACILITIES)" $(SCRIPT) @@ -741,7 +741,7 @@ cleanhelp: clean: cleanhelp $(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out - $(RM) $(TCLSH) $(CAT32) $(TEST_EXE_FILE) tcltest.cmd tcltest + $(RM) $(TCLSH) $(CAT32) $(TEST_EXE_FILE) tcltest.cmd tcltest.sh $(RM) *.pch *.ilk *.pdb distclean: clean -- cgit v0.12 From 267c44f6ea7e0ec37ec45621f70c49237c1e9ef8 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 20 Aug 2019 14:21:03 +0000 Subject: Backport some "knownMsvcBug" markers from 8.6: Those indicate test-cases the sporadically fail in the Travis Windows environment. --- tests/chanio.test | 98 +++++++++++++++++++++++++++---------------------------- tests/io.test | 83 +++++++++++++++++++++++----------------------- 2 files changed, 91 insertions(+), 90 deletions(-) diff --git a/tests/chanio.test b/tests/chanio.test index 541c20d..5d47e0b 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -2,16 +2,16 @@ # Functionality covered: operation of all IO commands, and all procedures # defined in generic/tclIO.c. # -# This file contains a collection of tests for one or more of the Tcl -# built-in commands. Sourcing this file into Tcl runs the tests and -# generates output for errors. No output means no errors were found. +# This file contains a collection of tests for one or more of the Tcl built-in +# commands. Sourcing this file into Tcl runs the tests and generates output +# for errors. No output means no errors were found. # # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. if {[catch {package require tcltest 2}]} { chan puts stderr "Skipping tests in [info script]. tcltest 2 required." @@ -38,13 +38,14 @@ namespace eval ::tcl::test::io { testConstraint testchannelevent [llength [info commands testchannelevent]] testConstraint testmainthread [llength [info commands testmainthread]] testConstraint testthread [llength [info commands testthread]] + testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] - # You need a *very* special environment to do some tests. In - # particular, many file systems do not support large-files... + # You need a *very* special environment to do some tests. In particular, + # many file systems do not support large-files... testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}] - # some tests can only be run is umask is 2 - # if "umask" cannot be run, the tests will be skipped. + # some tests can only be run is umask is 2 if "umask" cannot be run, the + # tests will be skipped. set umaskValue 0 testConstraint umask [expr {![catch {set umaskValue [scan [exec /bin/sh -c umask] %o]}]}] @@ -117,10 +118,10 @@ test chan-io-1.8 {Tcl_WriteChars: WriteChars} { # applied to tcl will cause tcl, more specifically WriteChars, to # go into an infinite loop. - set f [open $path(test2) w] - chan configure $f -encoding iso2022-jp - chan puts -nonewline $f [format %s%c [string repeat " " 4] 12399] - chan close $f + set f [open $path(test2) w] + chan configure $f -encoding iso2022-jp + chan puts -nonewline $f [format %s%c [string repeat " " 4] 12399] + chan close $f contents $path(test2) } " \x1b\$B\$O\x1b(B" @@ -186,7 +187,7 @@ test chan-io-1.9 {Tcl_WriteChars: WriteChars} { test chan-io-2.1 {WriteBytes} { # loop until all bytes are written - + set f [open $path(test1) w] chan configure $f -encoding binary -buffersize 16 -translation crlf chan puts $f "abcdefghijklmnopqrstuvwxyz" @@ -208,7 +209,7 @@ test chan-io-2.3 {WriteBytes: flush on line} { # Tcl "line" buffering has weird behavior: if current buffer contains # a \n, entire buffer gets flushed. Logical behavior would be to flush # only up to the \n. - + set f [open $path(test1) w] chan configure $f -encoding binary -buffering line -translation crlf chan puts -nonewline $f "\n12" @@ -228,7 +229,7 @@ test chan-io-2.4 {WriteBytes: reset sawLF after each buffer} { test chan-io-3.1 {WriteChars: compatibility with WriteBytes} { # loop until all bytes are written - + set f [open $path(test1) w] chan configure $f -encoding ascii -buffersize 16 -translation crlf chan puts $f "abcdefghijklmnopqrstuvwxyz" @@ -250,7 +251,7 @@ test chan-io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} { # Tcl "line" buffering has weird behavior: if current buffer contains # a \n, entire buffer gets flushed. Logical behavior would be to flush # only up to the \n. - + set f [open $path(test1) w] chan configure $f -encoding ascii -buffering line -translation crlf chan puts -nonewline $f "\n12" @@ -262,7 +263,7 @@ test chan-io-3.4 {WriteChars: loop over stage buffer} { # stage buffer maps to more than can be queued at once. set f [open $path(test1) w] - chan configure $f -encoding jis0208 -buffersize 16 + chan configure $f -encoding jis0208 -buffersize 16 chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" set x [list [contents $path(test1)]] chan close $f @@ -274,7 +275,7 @@ test chan-io-3.5 {WriteChars: saved != 0} { # requested buffersize. set f [open $path(test1) w] - chan configure $f -encoding jis0208 -buffersize 17 + chan configure $f -encoding jis0208 -buffersize 17 chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" set x [list [contents $path(test1)]] chan close $f @@ -305,7 +306,7 @@ test chan-io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} { # of the next channel buffer. set f [open $path(test1) w] - chan configure $f -encoding jis0208 -buffersize 17 + chan configure $f -encoding jis0208 -buffersize 17 chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" set x [list [contents $path(test1)]] chan close $f @@ -375,7 +376,7 @@ test chan-io-4.5 {TranslateOutputEOL: crlf} { test chan-io-5.1 {CheckFlush: not full} { set f [open $path(test1) w] - chan configure $f + chan configure $f chan puts -nonewline $f "12345678901234567890" set x [list [contents $path(test1)]] chan close $f @@ -464,7 +465,7 @@ set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" append a $a append a $a test chan-io-6.6 {Tcl_GetsObj: loop test} { - # if (dst >= dstEnd) + # if (dst >= dstEnd) set f [open $path(test1) w] chan puts $f $a @@ -763,7 +764,7 @@ test chan-io-6.32 {Tcl_GetsObj: crlf mode: buffer exhausted, more data} {testcha } [list 15 "123456789012345" 17 3] test chan-io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} { # eol still equals dstEnd - + set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "123456789012345\r" @@ -775,8 +776,8 @@ test chan-io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} { set x } [list 16 "123456789012345\r" 1] test chan-io-6.34 {Tcl_GetsObj: crlf mode: buffer exhausted, not followed by \n} { - # not (*eol == '\n') - + # not (*eol == '\n') + set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "123456789012345\rabcd\r\nefg" @@ -883,7 +884,7 @@ test chan-io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel openpipe fileev chan configure $f -buffersize 16 set x [list [chan gets $f]] chan configure $f -blocking 0 - lappend x [chan gets $f line] $line [testchannel queuedcr $f] + lappend x [chan gets $f line] $line [testchannel queuedcr $f] chan configure $f -blocking 1 chan puts -nonewline $f "\nabcd\refg\x1a" lappend x [chan gets $f line] $line [testchannel queuedcr $f] @@ -892,7 +893,7 @@ test chan-io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel openpipe fileev set x } [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"] test chan-io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel openpipe fileevent} { - # not (*eol == '\n') + # not (*eol == '\n') set f [open "|[list [interpreter] $path(cat)]" w+] chan configure $f -translation {auto lf} -buffering none @@ -900,7 +901,7 @@ test chan-io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testcha chan configure $f -buffersize 16 set x [list [chan gets $f]] chan configure $f -blocking 0 - lappend x [chan gets $f line] $line [testchannel queuedcr $f] + lappend x [chan gets $f line] $line [testchannel queuedcr $f] chan configure $f -blocking 1 chan puts -nonewline $f "abcd\refg\x1a" lappend x [chan gets $f line] $line [testchannel queuedcr $f] @@ -953,10 +954,10 @@ test chan-io-6.47 {Tcl_GetsObj: auto mode: \r at end of buffer, peek for \n} {te set x [list [chan gets $f] [testchannel inputbuffered $f]] chan close $f set x -} [list "123456789012345" 15] +} [list "123456789012345" 15] test chan-io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} {testchannel} { # PeekAhead() did not get any, so (eol >= dstEnd) - + set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "123456789012345\r" @@ -969,7 +970,7 @@ test chan-io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} { } [list "123456789012345" 1] test chan-io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} {testchannel} { # if (*eol == '\n') {skip++} - + set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "123456\r\n78901" @@ -980,8 +981,8 @@ test chan-io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} {testchannel} { set x } [list "123456" 0 8 "78901"] test chan-io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {testchannel} { - # not (*eol == '\n') - + # not (*eol == '\n') + set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "123456\r78901" @@ -993,7 +994,7 @@ test chan-io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {testchannel} } [list "123456" 0 7 "78901"] test chan-io-6.51 {Tcl_GetsObj: auto mode: \n} { # else if (*eol == '\n') {goto gotoeol;} - + set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "123456\n78901" @@ -1086,7 +1087,7 @@ test chan-io-7.1 {FilterInputBytes: split up character at end of buffer} { } "1234567890123\uff10\uff11\uff12\uff13\uff14" test chan-io-7.2 {FilterInputBytes: split up character in middle of buffer} { # (bufPtr->nextAdded < bufPtr->bufLength) - + set f [open $path(test1) w] chan configure $f -encoding binary chan puts -nonewline $f "1234567890\n123\x82\x4f\x82\x50\x82" @@ -1195,7 +1196,7 @@ test chan-io-8.4 {PeekAhead: cached data available in this buffer} { set x [chan gets $f] chan close $f - set x + set x } $a unset a test chan-io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel openpipe fileevent} { @@ -1211,7 +1212,7 @@ test chan-io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchann set x } {15 abcdefghijklmno 1} test chan-io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel openpipe fileevent} { - # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0) + # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0) set f [open "|[list [interpreter] $path(cat)]" w+] chan configure $f -translation {auto binary} -buffersize 16 @@ -1469,7 +1470,7 @@ test chan-io-13.2 {TranslateInputEOL: crlf mode} { set x } "abcd\ndef\n" test chan-io-13.3 {TranslateInputEOL: crlf mode: naked cr} { - # (src >= srcMax) + # (src >= srcMax) set f [open $path(test1) w] chan configure $f -translation lf @@ -1482,7 +1483,7 @@ test chan-io-13.3 {TranslateInputEOL: crlf mode: naked cr} { set x } "abcd\ndef\r" test chan-io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} { - # (src >= srcMax) + # (src >= srcMax) set f [open $path(test1) w] chan configure $f -translation lf @@ -1495,7 +1496,7 @@ test chan-io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} { set x } "abcd\ndef\rfgh" test chan-io-13.5 {TranslateInputEOL: crlf mode: naked lf} { - # (src >= srcMax) + # (src >= srcMax) set f [open $path(test1) w] chan configure $f -translation lf @@ -1571,7 +1572,7 @@ test chan-io-13.9 {TranslateInputEOL: auto mode: \r followed by not \n} { set x } "abcd\ndef" test chan-io-13.10 {TranslateInputEOL: auto mode: \n} { - # not (*src == '\r') + # not (*src == '\r') set f [open $path(test1) w] chan configure $f -translation lf @@ -1920,7 +1921,7 @@ test chan-io-20.1 {Tcl_CreateChannel: initial settings} { encoding system $old chan close $a set x -} {ascii} +} {ascii} test chan-io-20.2 {Tcl_CreateChannel: initial settings} {win} { set f [open $path(test1) w+] set x [list [chan configure $f -eofchar] [chan configure $f -translation]] @@ -2015,7 +2016,7 @@ test chan-io-26.1 {Tcl_GetChannelInstanceData} {stdio openpipe} { set f [open "|[list [interpreter] << exit]"] expr [pid $f] chan close $f -} {} +} {} # Test flushing. The functions tested here are FlushChannel. @@ -2736,7 +2737,7 @@ test chan-io-29.33 {Tcl_Flush, implicit flush on exit} {exec} { chan close $f set r } "hello\nbye\nstrange\n" -test chan-io-29.34 {Tcl_Chan Close, async flush on chan close, using sockets} {socket tempNotMac fileevent} { +test chan-io-29.34 {Tcl_Chan Close, async flush on chan close, using sockets} {socket tempNotMac fileevent knownMsvcBug} { variable c 0 variable x running set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz @@ -2755,7 +2756,6 @@ test chan-io-29.34 {Tcl_Chan Close, async flush on chan close, using sockets} {s variable c variable x set l [chan gets $s] - if {[chan eof $s]} { chan close $s set x done @@ -2887,7 +2887,7 @@ test chan-io-30.6 {Tcl_Write cr, Tcl_Read crlf} { chan configure $f -translation crlf set x [chan read $f] chan close $f - set x + set x } "hello\rthere\rand\rhere\r" test chan-io-30.7 {Tcl_Write crlf, Tcl_Read crlf} { file delete $path(test1) @@ -3815,7 +3815,7 @@ test chan-io-31.31 {Tcl_Write crlf on block boundary, Tcl_Gets crlf} { } chan close $f set f [open $path(test1) r] - chan configure $f -translation crlf + chan configure $f -translation crlf set c "" while {[chan gets $f line] >= 0} { append c $line\n @@ -5044,7 +5044,7 @@ test chan-io-39.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} { test chan-io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} { file delete $path(test1) set f [open $path(test1) w] - chan configure $f -encoding {} + chan configure $f -encoding {} chan puts -nonewline $f \xe7\x89\xa6 chan close $f set f [open $path(test1) r] @@ -5837,7 +5837,7 @@ test chan-io-48.3 {testing readability conditions} {stdio unix nonBlockFiles ope list $x $l } {done {0 1 0 1 0 1 0 1 0 1 0 1 0 0}} unset path(bar) -removeFile bar +removeFile bar test chan-io-48.4 {lf write, testing readability, ^Z termination, auto read mode} {fileevent} { file delete $path(test1) diff --git a/tests/io.test b/tests/io.test index 5529881..0703ee2 100644 --- a/tests/io.test +++ b/tests/io.test @@ -39,6 +39,7 @@ testConstraint testchannelevent [llength [info commands testchannelevent]] testConstraint testmainthread [llength [info commands testmainthread]] testConstraint testthread [llength [info commands testthread]] testConstraint testobj [llength [info commands testobj]] +testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] # You need a *very* special environment to do some tests. In # particular, many file systems do not support large-files... @@ -118,10 +119,10 @@ test io-1.8 {Tcl_WriteChars: WriteChars} { # applied to tcl will cause tcl, more specifically WriteChars, to # go into an infinite loop. - set f [open $path(test2) w] - fconfigure $f -encoding iso2022-jp - puts -nonewline $f [format %s%c [string repeat " " 4] 12399] - close $f + set f [open $path(test2) w] + fconfigure $f -encoding iso2022-jp + puts -nonewline $f [format %s%c [string repeat " " 4] 12399] + close $f contents $path(test2) } " \x1b\$B\$O\x1b(B" @@ -187,7 +188,7 @@ test io-1.9 {Tcl_WriteChars: WriteChars} { test io-2.1 {WriteBytes} { # loop until all bytes are written - + set f [open $path(test1) w] fconfigure $f -encoding binary -buffersize 16 -translation crlf puts $f "abcdefghijklmnopqrstuvwxyz" @@ -209,7 +210,7 @@ test io-2.3 {WriteBytes: flush on line} { # Tcl "line" buffering has weird behavior: if current buffer contains # a \n, entire buffer gets flushed. Logical behavior would be to flush # only up to the \n. - + set f [open $path(test1) w] fconfigure $f -encoding binary -buffering line -translation crlf puts -nonewline $f "\n12" @@ -229,7 +230,7 @@ test io-2.4 {WriteBytes: reset sawLF after each buffer} { test io-3.1 {WriteChars: compatibility with WriteBytes} { # loop until all bytes are written - + set f [open $path(test1) w] fconfigure $f -encoding ascii -buffersize 16 -translation crlf puts $f "abcdefghijklmnopqrstuvwxyz" @@ -251,7 +252,7 @@ test io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} { # Tcl "line" buffering has weird behavior: if current buffer contains # a \n, entire buffer gets flushed. Logical behavior would be to flush # only up to the \n. - + set f [open $path(test1) w] fconfigure $f -encoding ascii -buffering line -translation crlf puts -nonewline $f "\n12" @@ -263,7 +264,7 @@ test io-3.4 {WriteChars: loop over stage buffer} { # stage buffer maps to more than can be queued at once. set f [open $path(test1) w] - fconfigure $f -encoding jis0208 -buffersize 16 + fconfigure $f -encoding jis0208 -buffersize 16 puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" set x [list [contents $path(test1)]] close $f @@ -275,7 +276,7 @@ test io-3.5 {WriteChars: saved != 0} { # requested buffersize. set f [open $path(test1) w] - fconfigure $f -encoding jis0208 -buffersize 17 + fconfigure $f -encoding jis0208 -buffersize 17 puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" set x [list [contents $path(test1)]] close $f @@ -306,7 +307,7 @@ test io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} { # of the next channel buffer. set f [open $path(test1) w] - fconfigure $f -encoding jis0208 -buffersize 17 + fconfigure $f -encoding jis0208 -buffersize 17 puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" set x [list [contents $path(test1)]] close $f @@ -376,7 +377,7 @@ test io-4.5 {TranslateOutputEOL: crlf} { test io-5.1 {CheckFlush: not full} { set f [open $path(test1) w] - fconfigure $f + fconfigure $f puts -nonewline $f "12345678901234567890" set x [list [contents $path(test1)]] close $f @@ -465,7 +466,7 @@ set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" append a $a append a $a test io-6.6 {Tcl_GetsObj: loop test} { - # if (dst >= dstEnd) + # if (dst >= dstEnd) set f [open $path(test1) w] puts $f $a @@ -764,7 +765,7 @@ test io-6.32 {Tcl_GetsObj: crlf mode: buffer exhausted, more data} {testchannel} } [list 15 "123456789012345" 17 3] test io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} { # eol still equals dstEnd - + set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "123456789012345\r" @@ -776,8 +777,8 @@ test io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} { set x } [list 16 "123456789012345\r" 1] test io-6.34 {Tcl_GetsObj: crlf mode: buffer exhausted, not followed by \n} { - # not (*eol == '\n') - + # not (*eol == '\n') + set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "123456789012345\rabcd\r\nefg" @@ -884,7 +885,7 @@ test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel openpipe fileevent} fconfigure $f -buffersize 16 set x [list [gets $f]] fconfigure $f -blocking 0 - lappend x [gets $f line] $line [testchannel queuedcr $f] + lappend x [gets $f line] $line [testchannel queuedcr $f] fconfigure $f -blocking 1 puts -nonewline $f "\nabcd\refg\x1a" lappend x [gets $f line] $line [testchannel queuedcr $f] @@ -893,7 +894,7 @@ test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel openpipe fileevent} set x } [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"] test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel openpipe fileevent} { - # not (*eol == '\n') + # not (*eol == '\n') set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -translation {auto lf} -buffering none @@ -901,7 +902,7 @@ test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel fconfigure $f -buffersize 16 set x [list [gets $f]] fconfigure $f -blocking 0 - lappend x [gets $f line] $line [testchannel queuedcr $f] + lappend x [gets $f line] $line [testchannel queuedcr $f] fconfigure $f -blocking 1 puts -nonewline $f "abcd\refg\x1a" lappend x [gets $f line] $line [testchannel queuedcr $f] @@ -954,10 +955,10 @@ test io-6.47 {Tcl_GetsObj: auto mode: \r at end of buffer, peek for \n} {testcha set x [list [gets $f] [testchannel inputbuffered $f]] close $f set x -} [list "123456789012345" 15] +} [list "123456789012345" 15] test io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} {testchannel} { # PeekAhead() did not get any, so (eol >= dstEnd) - + set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "123456789012345\r" @@ -970,7 +971,7 @@ test io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} {testc } [list "123456789012345" 1] test io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} {testchannel} { # if (*eol == '\n') {skip++} - + set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "123456\r\n78901" @@ -981,8 +982,8 @@ test io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} {testchannel} { set x } [list "123456" 0 8 "78901"] test io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {testchannel} { - # not (*eol == '\n') - + # not (*eol == '\n') + set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "123456\r78901" @@ -994,7 +995,7 @@ test io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {testchannel} { } [list "123456" 0 7 "78901"] test io-6.51 {Tcl_GetsObj: auto mode: \n} { # else if (*eol == '\n') {goto gotoeol;} - + set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "123456\n78901" @@ -1087,7 +1088,7 @@ test io-7.1 {FilterInputBytes: split up character at end of buffer} { } "1234567890123\uff10\uff11\uff12\uff13\uff14" test io-7.2 {FilterInputBytes: split up character in middle of buffer} { # (bufPtr->nextAdded < bufPtr->bufLength) - + set f [open $path(test1) w] fconfigure $f -encoding binary puts -nonewline $f "1234567890\n123\x82\x4f\x82\x50\x82" @@ -1196,7 +1197,7 @@ test io-8.4 {PeekAhead: cached data available in this buffer} { set x [gets $f] close $f - set x + set x } $a unset a test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel openpipe fileevent} { @@ -1212,7 +1213,7 @@ test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel op set x } {15 abcdefghijklmno 1} test io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel openpipe fileevent} { - # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0) + # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0) set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -translation {auto binary} -buffersize 16 @@ -1569,7 +1570,7 @@ test io-13.2 {TranslateInputEOL: crlf mode} { set x } "abcd\ndef\n" test io-13.3 {TranslateInputEOL: crlf mode: naked cr} { - # (src >= srcMax) + # (src >= srcMax) set f [open $path(test1) w] fconfigure $f -translation lf @@ -1582,7 +1583,7 @@ test io-13.3 {TranslateInputEOL: crlf mode: naked cr} { set x } "abcd\ndef\r" test io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} { - # (src >= srcMax) + # (src >= srcMax) set f [open $path(test1) w] fconfigure $f -translation lf @@ -1595,7 +1596,7 @@ test io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} { set x } "abcd\ndef\rfgh" test io-13.5 {TranslateInputEOL: crlf mode: naked lf} { - # (src >= srcMax) + # (src >= srcMax) set f [open $path(test1) w] fconfigure $f -translation lf @@ -1710,7 +1711,7 @@ test io-13.9 {TranslateInputEOL: auto mode: \r followed by not \n} { set x } "abcd\ndef" test io-13.10 {TranslateInputEOL: auto mode: \n} { - # not (*src == '\r') + # not (*src == '\r') set f [open $path(test1) w] fconfigure $f -translation lf @@ -2059,7 +2060,7 @@ test io-20.1 {Tcl_CreateChannel: initial settings} { encoding system $old close $a set x -} {ascii} +} {ascii} test io-20.2 {Tcl_CreateChannel: initial settings} {win} { set f [open $path(test1) w+] set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]] @@ -2154,7 +2155,7 @@ test io-26.1 {Tcl_GetChannelInstanceData} {stdio openpipe} { set f [open "|[list [interpreter] << exit]"] expr [pid $f] close $f -} {} +} {} # Test flushing. The functions tested here are FlushChannel. @@ -2224,7 +2225,7 @@ test io-27.5 {FlushChannel, implicit flush when buffer fills and on close} \ set path(pipe) [makeFile {} pipe] set path(output) [makeFile {} output] test io-27.6 {FlushChannel, async flushing, async close} \ - {stdio asyncPipeClose openpipe} { + {stdio asyncPipeClose openpipe knownMsvcBug} { # This test may fail on old Unix systems (seen on IRIX64 6.5) with # obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197. file delete $path(pipe) @@ -2828,7 +2829,7 @@ test io-29.31 {Tcl_WriteChars, background flush} {stdio openpipe} { set result } ok test io-29.32 {Tcl_WriteChars, background flush to slow reader} \ - {stdio asyncPipeClose openpipe} { + {stdio asyncPipeClose openpipe knownMsvcBug} { # This test may fail on old Unix systems (seen on IRIX64 6.5) with # obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197. file delete $path(pipe) @@ -3032,7 +3033,7 @@ test io-30.6 {Tcl_Write cr, Tcl_Read crlf} { fconfigure $f -translation crlf set x [read $f] close $f - set x + set x } "hello\rthere\rand\rhere\r" test io-30.7 {Tcl_Write crlf, Tcl_Read crlf} { file delete $path(test1) @@ -3960,7 +3961,7 @@ test io-31.31 {Tcl_Write crlf on block boundary, Tcl_Gets crlf} { } close $f set f [open $path(test1) r] - fconfigure $f -translation crlf + fconfigure $f -translation crlf set c "" while {[gets $f line] >= 0} { append c $line\n @@ -5442,7 +5443,7 @@ test io-39.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} { test io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -encoding {} + fconfigure $f -encoding {} puts -nonewline $f \xe7\x89\xa6 close $f set f [open $path(test1) r] @@ -8535,11 +8536,11 @@ test io-74.1 {[104f2885bb] improper cache validity check} -setup { interp create slave } -constraints testobj -body { teststringobj set 1 [string range $rfd 0 end] - read [teststringobj get 1] + read [teststringobj get 1] testobj duplicate 1 2 interp transfer {} $rfd slave catch {read [teststringobj get 1]} - read [teststringobj get 2] + read [teststringobj get 2] } -cleanup { interp delete slave testobj freeallvars -- cgit v0.12 From 33b8dd931e270d9802ba796a6cd6c0e63b200237 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 22 Aug 2019 12:19:04 +0000 Subject: Fix [8566dc22f9]: various spelling fixes in comments --- generic/tclPipe.c | 2 +- unix/configure.in | 2 +- unix/tclUnixChan.c | 2 +- unix/tclUnixInit.c | 2 +- unix/tclUnixTime.c | 4 ++-- win/tclWinInit.c | 2 +- win/tclWinTime.c | 2 +- 7 files changed, 8 insertions(+), 8 deletions(-) diff --git a/generic/tclPipe.c b/generic/tclPipe.c index 698f85d..a549942 100644 --- a/generic/tclPipe.c +++ b/generic/tclPipe.c @@ -442,7 +442,7 @@ TclCreatePipeline( * at *inPipePtr. NULL means command specified * its own input source. */ TclFile *outPipePtr, /* If non-NULL, output to the pipeline goes to - * a pipe, unless overriden by redirection in + * a pipe, unless overridden by redirection in * the command. The file id with which to read * frome this pipe is stored at *outPipePtr. * NULL means command specified its own output diff --git a/unix/configure.in b/unix/configure.in index e4255b6..24e6b90 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -610,7 +610,7 @@ AC_MSG_RESULT([$tcl_ok]) #------------------------------------------------------------------------ # Check whether the timezone data is supplied by the OS or has # to be installed by Tcl. The default is autodetection, but can -# be overriden on the configure command line either way. +# be overridden on the configure command line either way. #------------------------------------------------------------------------ AC_MSG_CHECKING([for timezone data]) diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index 8448b77..9cac4ae 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -123,7 +123,7 @@ typedef struct TtyState { /* * The following structure is used to set or get the serial port attributes in - * a platform-independant manner. + * a platform-independent manner. */ typedef struct TtyAttrs { diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index b1a4b24..93f2964 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -401,7 +401,7 @@ long tclMacOSXDarwinRelease = 0; * * TclpInitPlatform -- * - * Initialize all the platform-dependant things like signals and + * Initialize all the platform-dependent things like signals and * floating-point error handling. * * Called at process initialization time. diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c index 1b4ea15..4860876 100644 --- a/unix/tclUnixTime.c +++ b/unix/tclUnixTime.c @@ -118,7 +118,7 @@ TclpGetMicroseconds(void) * This procedure returns a value that represents the highest resolution * clock available on the system. There are no garantees on what the * resolution will be. In Tcl we will call this value a "click". The - * start time is also system dependant. + * start time is also system dependent. * * Results: * Number of clicks from some start time. @@ -167,7 +167,7 @@ TclpGetClicks(void) * This procedure returns a WideInt value that represents the highest * resolution clock available on the system. There are no garantees on * what the resolution will be. In Tcl we will call this value a "click". - * The start time is also system dependant. + * The start time is also system dependent. * * Results: * Number of WideInt clicks from some start time. diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 7fa2b7a..9277463 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -113,7 +113,7 @@ static int ToUtf(CONST WCHAR *wSrc, char *dst); * * TclpInitPlatform -- * - * Initialize all the platform-dependant things like signals, + * Initialize all the platform-dependent things like signals, * floating-point error handling and sockets. * * Called at process initialization time. diff --git a/win/tclWinTime.c b/win/tclWinTime.c index 0a638e8..c3c22a4 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -194,7 +194,7 @@ TclpGetSeconds(void) * This procedure returns a value that represents the highest resolution * clock available on the system. There are no guarantees on what the * resolution will be. In Tcl we will call this value a "click". The - * start time is also system dependant. + * start time is also system dependent. * * Results: * Number of clicks from some start time. -- cgit v0.12 From 735845efe4f743ec50ea92a38f33ee1f365685d2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 23 Aug 2019 08:29:06 +0000 Subject: Attempt to fix [3947fcf7]: Current .gitattributes settings might not allow switching branches --- .gitattributes | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/.gitattributes b/.gitattributes index 82bed50..420e405 100755 --- a/.gitattributes +++ b/.gitattributes @@ -1,5 +1,6 @@ # Set the default behavior, in case people don't have core.autocrlf set. -* text eol=lf +* eol=lf +* text=auto # Explicitly declare text files you want to always be normalized and converted # to native line endings on checkout. @@ -20,9 +21,9 @@ *.test text # Declare files that will always have CRLF line endings on checkout. -*.bat text eol=crlf -*.sln text eol=crlf -*.vc text eol=crlf +*.bat eol=crlf +*.sln eol=crlf +*.vc eol=crlf # Denote all files that are truly binary and should not be modified. *.a binary -- cgit v0.12 From a02c3110409ef6de5cd52ce1a100e229c9c1c0a3 Mon Sep 17 00:00:00 2001 From: andy Date: Sat, 24 Aug 2019 18:30:47 +0000 Subject: Correct NUL encoding in documentation --- doc/StringObj.3 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/StringObj.3 b/doc/StringObj.3 index 7042cc8..c23706f 100644 --- a/doc/StringObj.3 +++ b/doc/StringObj.3 @@ -91,7 +91,7 @@ Points to the first byte of an array of UTF-8-encoded bytes used to set or append to a string value. This byte array may contain embedded null characters unless \fInumChars\fR is negative. (Applications needing null bytes -should represent them as the two-byte sequence \fI\e700\e600\fR, use +should represent them as the two-byte sequence \fI\e300\e200\fR, use \fBTcl_ExternalToUtf\fR to convert, or \fBTcl_NewByteArrayObj\fR if the string is a collection of uninterpreted bytes.) .AP int length in -- cgit v0.12 From 51d243e5028ef51dcc9fbd67847a4ffc31ad576b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 26 Aug 2019 07:46:40 +0000 Subject: One more "knownMsvcBug" marker, for a test-case which failed (incidentally) in Travis. --- tests/winTime.test | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/tests/winTime.test b/tests/winTime.test index 278db32..3787be3 100644 --- a/tests/winTime.test +++ b/tests/winTime.test @@ -16,6 +16,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} { } testConstraint testwinclock [llength [info commands testwinclock]] +testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] # The next two tests will crash on Windows if the check for negative # clock values is not done properly. @@ -37,7 +38,7 @@ test winTime-1.2 {TclpGetDate} {win} { # with the Windows clock. 30 sec really isn't enough, # but how much time does a tester have patience for? -test winTime-2.1 {Synchronization of Tcl and Windows clocks} {testwinclock} { +test winTime-2.1 {Synchronization of Tcl and Windows clocks} {testwinclock knownMsvcBug} { # May fail due to OS/hardware discrepancies. See: # http://support.microsoft.com/default.aspx?scid=kb;en-us;274323 set failed {} @@ -47,7 +48,7 @@ test winTime-2.1 {Synchronization of Tcl and Windows clocks} {testwinclock} { foreach { sys_sec sys_usec tcl_sec tcl_usec } [testwinclock] break set diff [expr { $tcl_sec - $sys_sec + 1.0e-6 * ( $tcl_usec - $sys_usec ) }] - if { abs($diff) > 0.06 } { + if { abs($diff) > 0.1 } { set failed "Tcl clock differs from system clock by $diff sec" break } else { -- cgit v0.12 From 1637e28f70335fec7893a8dea29b33f7bb856658 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 26 Aug 2019 08:52:14 +0000 Subject: If tcltest's removeFile fails for a non-expected reason (e.g. Windows keeps the file locked), this should not result in a test failure, just a warning. Observed in this Travis build: [https://travis-ci.org/tcltk/tcl/jobs/576443957] Tcl test 2.5.0 -> 2.5.1 --- library/tcltest/pkgIndex.tcl | 2 +- library/tcltest/tcltest.tcl | 9 +++++++-- tests/all.tcl | 2 +- 3 files changed, 9 insertions(+), 4 deletions(-) diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl index fde3ffe..ca93725 100644 --- a/library/tcltest/pkgIndex.tcl +++ b/library/tcltest/pkgIndex.tcl @@ -9,4 +9,4 @@ # full path name of this file's directory. if {![package vsatisfies [package provide Tcl] 8.5-]} {return} -package ifneeded tcltest 2.5.0 [list source [file join $dir tcltest.tcl]] +package ifneeded tcltest 2.5.1 [list source [file join $dir tcltest.tcl]] diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index d67a900..a7a68c7 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -22,7 +22,7 @@ namespace eval tcltest { # When the version number changes, be sure to update the pkgIndex.tcl file, # and the install directory in the Makefiles. When the minor version # changes (new feature) be sure to update the man page as well. - variable Version 2.5.0 + variable Version 2.5.1 # Compatibility support for dumb variables defined in tcltest 1 # Do not use these. Call [package provide Tcl] and [info patchlevel] @@ -3072,7 +3072,12 @@ proc tcltest::removeFile {name {directory ""}} { Warn "removeFile removing \"$fullName\":\n not a file" } } - return [file delete -- $fullName] + if {[catch {file delete -- $fullName} msg ]} { + DebugDo 1 { + Warn "removeFile removing \"$fullName\":\n failed: $msg" + } + } + return } # tcltest::makeDirectory -- diff --git a/tests/all.tcl b/tests/all.tcl index f3463c6..7d86640 100644 --- a/tests/all.tcl +++ b/tests/all.tcl @@ -11,7 +11,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package require Tcl 8.5 -package require tcltest 2.2 +package require tcltest 2.5 namespace import tcltest::* configure {*}$argv -testdir [file dir [info script]] set ErrorOnFailures [info exists env(ERROR_ON_FAILURES)] -- cgit v0.12 From eba8349b2c75c6244f5cbe33088c90eec93c4323 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 27 Aug 2019 11:37:19 +0000 Subject: Backport two knownMsvcBug markers, which hit us (again) on Travis. --- tests/cmdMZ.test | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test index 45d68b3..93bd6b1 100644 --- a/tests/cmdMZ.test +++ b/tests/cmdMZ.test @@ -28,6 +28,8 @@ namespace eval ::tcl::test::cmdMZ { namespace import ::tcl::unsupported::timerate } + testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] + # Tcl_PwdObjCmd test cmdMZ-1.1 {Tcl_PwdObjCmd} { @@ -162,7 +164,7 @@ test cmdMZ-return-2.15 {return opton handling} -setup { } -cleanup { rename p {} } -result {1 c {a b}} - + test cmdMZ-return-2.16 {return opton handling} -setup { proc p {} { return -code error -errorcode [list a b] c @@ -172,7 +174,7 @@ test cmdMZ-return-2.16 {return opton handling} -setup { } -cleanup { rename p {} } -result {1 c {a b}} - + test cmdMZ-return-2.17 {return opton handling} -setup { proc p {} { return -code error -errorcode a\ b c @@ -182,7 +184,7 @@ test cmdMZ-return-2.17 {return opton handling} -setup { } -cleanup { rename p {} } -result {1 c {a b}} - + # Check that the result of a [return -options $opts $result] is # indistinguishable from that of the originally caught script, no @@ -301,7 +303,7 @@ test cmdMZ-4.10 {Tcl_SplitObjCmd: basic split commands} { foreach f [split {]\n} {}] { append x $f } - return $x + return $x } foo } {]\n} @@ -325,7 +327,7 @@ test cmdMZ-4.13 {Tcl_SplitObjCmd: basic split commands} { # The tests for Tcl_SubstObjCmd are in subst.test # The tests for Tcl_SwitchObjCmd are in switch.test -# todo: rewrite this if monotonic clock is provided resp. command "after" +# todo: rewrite this if monotonic clock is provided resp. command "after" # gets microsecond accuracy (RFE [fdfbd5e10] gets merged): proc _nrt_sleep {msec} { set usec [expr {$msec * 1000}] @@ -348,7 +350,7 @@ test cmdMZ-5.4 {Tcl_TimeObjCmd: nothing happens with negative iteration counts} test cmdMZ-5.5 {Tcl_TimeObjCmd: result format} { regexp {^\d+ microseconds per iteration} [time {format 1}] } 1 -test cmdMZ-5.6 {Tcl_TimeObjCmd: slower commands take longer} { +test cmdMZ-5.6 {Tcl_TimeObjCmd: slower commands take longer} knownMsvcBug { expr {[lindex [time {_nrt_sleep 1}] 0] < [lindex [time {_nrt_sleep 20}] 0]} } 1 test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} { @@ -401,7 +403,7 @@ test cmdMZ-6.5a {Tcl_TimeRateObjCmd: result format and one iteration} { test cmdMZ-6.5b {Tcl_TimeRateObjCmd: result format without iterations} { regexp {^0 \ws/# 0 # 0 #/sec 0 net-ms$} [timerate {} 0 0] } 1 -test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measument} { +test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measument} knownMsvcBug { set m1 [timerate {_nrt_sleep 0} 20] set m2 [timerate {_nrt_sleep 0.2} 20] list \ -- cgit v0.12 From ac370c9a7305ebde8a9d3439fa5260e925d3bba3 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 27 Aug 2019 11:53:43 +0000 Subject: One more knownMsvcBug marker (seen in Travis). Properly export ::tcltest::testConstraint in cmdMZ.test --- tests/cmdMZ.test | 1 + tests/io.test | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test index 93bd6b1..98cb0fb 100644 --- a/tests/cmdMZ.test +++ b/tests/cmdMZ.test @@ -22,6 +22,7 @@ namespace eval ::tcl::test::cmdMZ { namespace import ::tcltest::makeFile namespace import ::tcltest::removeFile namespace import ::tcltest::temporaryDirectory + namespace import ::tcltest::testConstraint namespace import ::tcltest::test if {[namespace which -command ::tcl::unsupported::timerate] ne ""} { diff --git a/tests/io.test b/tests/io.test index 0703ee2..13ff38c 100644 --- a/tests/io.test +++ b/tests/io.test @@ -7893,7 +7893,7 @@ test io-53.15 {[ed29c4da21] DoRead: fblocked seen as error} -setup { removeFile out } -result 100 -test io-54.1 {Recursive channel events} {socket fileevent} { +test io-54.1 {Recursive channel events} {socket fileevent knownMsvcBug} { # This test checks to see if file events are delivered during recursive # event loops when there is buffered data on the channel. -- cgit v0.12 From 1149b24a6ef5f229a58fa36cfdbe6a1f345ed71b Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 27 Aug 2019 12:03:51 +0000 Subject: added tests covering bug [fa6bf38d07] --- generic/tclTest.c | 21 +++++++++++++++++++++ tests/execute.test | 40 ++++++++++++++++++++++++++++++++++++---- 2 files changed, 57 insertions(+), 4 deletions(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index 473368c..5e807d4 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -220,6 +220,9 @@ 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[]); @@ -584,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, @@ -1022,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; +} + /* *---------------------------------------------------------------------- * diff --git a/tests/execute.test b/tests/execute.test index e9668a9..bc9dfcf 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -37,6 +37,11 @@ testConstraint testobj [expr { testConstraint longIs32bit [expr {int(0x80000000) < 0}] testConstraint testexprlongobj [llength [info commands testexprlongobj]] + +if {[namespace which -command testbumpinterpepoch] eq ""} { + proc testbumpinterpepoch {} { rename ::set ::dummy; rename ::dummy ::set } +} + # Tests for the omnibus TclExecuteByteCode function: # INST_DONE not tested @@ -933,8 +938,7 @@ test execute-8.3 {Stack restoration} -setup { proc f {args} "f $arglst" proc run {} { # bump the interp's epoch - rename ::set ::dummy - rename ::dummy ::set + testbumpinterpepoch catch f msg set msg } @@ -948,8 +952,7 @@ test execute-8.4 {Compile epoch bump effect on stack trace} -setup { } proc FOO {} { catch {error bar} m o - rename ::set ::dummy - rename ::dummy ::set + testbumpinterpepoch return -options $o $m } } -body { @@ -978,6 +981,35 @@ test execute-8.5 {Bug 2038069} -setup { invoked from within "catch \[list error FOO\] m o"} -errorline 2} +test execute-8.6 {Compile epoch bump in global level (bug [fa6bf38d07])} -setup { + interp create slave + slave eval { + package require tcltest + catch [list package require -exact Tcltest [info patchlevel]] + ::tcltest::loadTestedCommands + if {[namespace which -command testbumpinterpepoch] eq ""} { + proc testbumpinterpepoch {} { rename ::set ::dummy; rename ::dummy ::set } + } + } +} -body { + slave eval { + lappend res A; testbumpinterpepoch; lappend res B; return; lappend res C; + } + slave eval { + set i 0; while {[incr i] < 3} { + lappend res A; testbumpinterpepoch; lappend res B; return; lappend res C; + } + } + slave eval { + set i 0; while {[incr i] < 3} { + lappend res A; testbumpinterpepoch; lappend res B; break; lappend res C; + } + } + slave eval {set res} +} -cleanup { + interp delete slave +} -result [lrepeat 3 A B] + test execute-9.1 {Interp result resetting [Bug 1522803]} { set c 0 catch { -- cgit v0.12 From 045b6322e8966c4321b829083490ae5d746f9a92 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 27 Aug 2019 14:56:17 +0000 Subject: more test cases --- tests/execute.test | 43 ++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 42 insertions(+), 1 deletion(-) diff --git a/tests/execute.test b/tests/execute.test index bc9dfcf..72d79fd 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -1005,10 +1005,51 @@ test execute-8.6 {Compile epoch bump in global level (bug [fa6bf38d07])} -setup lappend res A; testbumpinterpepoch; lappend res B; break; lappend res C; } } + slave eval { + catch { + lappend res A; testbumpinterpepoch; lappend res B; error test; lappend res C; + } + } slave eval {set res} } -cleanup { interp delete slave -} -result [lrepeat 3 A B] +} -result [lrepeat 4 A B] +test execute-8.7 {Compile epoch bump in global level (bug [fa6bf38d07]), exception case} -setup { + interp create slave + slave eval { + package require tcltest + catch [list package require -exact Tcltest [info patchlevel]] + ::tcltest::loadTestedCommands + if {[namespace which -command testbumpinterpepoch] eq ""} { + proc testbumpinterpepoch {} { rename ::set ::dummy; rename ::dummy ::set } + } + } +} -body { + set res {} + lappend res [catch { + slave eval { + lappend res A; testbumpinterpepoch; lappend res B; return -code error test; lappend res C; + } + } e] $e + lappend res [catch { + slave eval { + lappend res A; testbumpinterpepoch; lappend res B; error test; lappend res C; + } + } e] $e + lappend res [catch { + slave eval { + lappend res A; testbumpinterpepoch; lappend res B; return -code return test; lappend res C; + } + } e] $e + lappend res [catch { + slave eval { + lappend res A; testbumpinterpepoch; lappend res B; break; lappend res C; + } + } e] $e + list $res [slave eval {set res}] +} -cleanup { + interp delete slave +} -result [list {1 test 1 test 2 test 3 {}} [lrepeat 4 A B]] test execute-9.1 {Interp result resetting [Bug 1522803]} { set c 0 -- cgit v0.12 From 6a3d250548f9acc17013c28b36a7d1fc3490edd5 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 27 Aug 2019 15:00:44 +0000 Subject: fixes [fa6bf38d07]: command invocation (NRE callback to TEBCResume) caused by execution of recompiled TEBC (on epoch bump) --- generic/tclExecute.c | 29 ++++++++++++++++++++--------- 1 file changed, 20 insertions(+), 9 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 832054e..873cac3 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -2400,12 +2400,12 @@ TEBCresume( iPtr->cmdCount += TclGetUInt4AtPtr(pc+5); if (checkInterp) { - checkInterp = 0; if (((codePtr->compileEpoch != iPtr->compileEpoch) || (codePtr->nsEpoch != iPtr->varFramePtr->nsPtr->resolverEpoch)) && !(codePtr->flags & TCL_BYTECODE_PRECOMPILED)) { goto instStartCmdFailed; } + checkInterp = 0; } inst = *(pc += 9); goto peepholeStart; @@ -2975,7 +2975,6 @@ TEBCresume( * INVOCATION BLOCK */ - instEvalStk: case INST_EVAL_STK: bcFramePtr->data.tebc.pc = (char *) pc; iPtr->cmdFramePtr = bcFramePtr; @@ -8157,26 +8156,38 @@ TEBCresume( { const char *bytes; - checkInterp = 1; length = 0; + if (TclInterpReady(interp) == TCL_ERROR) { + goto gotError; + } + /* * We used to switch to direct eval; for NRE-awareness we now * compile and eval the command so that this evaluation does not - * add a new TEBC instance. [Bug 2910748] + * add a new TEBC instance. Bug [2910748], bug [fa6bf38d07] + * + * TODO: recompile, search this command and eval a code starting from, + * so that this evaluation does not add a new TEBC instance without + * NRE-trampoline. */ - if (TclInterpReady(interp) == TCL_ERROR) { - goto gotError; - } - codePtr->flags |= TCL_BYTECODE_RECOMPILE; bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL, NULL); opnd = TclGetUInt4AtPtr(pc+1); pc += (opnd-1); assert(bytes); PUSH_OBJECT(Tcl_NewStringObj(bytes, length)); - goto instEvalStk; + + bcFramePtr->data.tebc.pc = (char *) pc; + iPtr->cmdFramePtr = bcFramePtr; + cleanup = 1; + pc += 1; + /* yield next instruction */ + TEBC_YIELD(); + /* add TEBCResume for this command */ + return TclNRExecuteByteCode(interp, + TclCompileObj(interp, OBJ_AT_TOS, NULL, 0)); } } -- cgit v0.12 From 64f262df8870d2caeeda595d9a4073ae1b40150b Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 27 Aug 2019 15:32:58 +0000 Subject: simplification, use the same "fixed" (and faster) code for INST_EVAL_STK --- generic/tclExecute.c | 17 ++++++----------- 1 file changed, 6 insertions(+), 11 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 873cac3..aff2c51 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -2976,13 +2976,17 @@ TEBCresume( */ case INST_EVAL_STK: + instEvalStk: bcFramePtr->data.tebc.pc = (char *) pc; iPtr->cmdFramePtr = bcFramePtr; cleanup = 1; pc += 1; + /* yield next instruction */ TEBC_YIELD(); - return TclNREvalObjEx(interp, OBJ_AT_TOS, 0, NULL, 0); + /* add TEBCResume for object at top of stack */ + return TclNRExecuteByteCode(interp, + TclCompileObj(interp, OBJ_AT_TOS, NULL, 0)); case INST_INVOKE_EXPANDED: CLANG_ASSERT(auxObjList); @@ -8178,16 +8182,7 @@ TEBCresume( pc += (opnd-1); assert(bytes); PUSH_OBJECT(Tcl_NewStringObj(bytes, length)); - - bcFramePtr->data.tebc.pc = (char *) pc; - iPtr->cmdFramePtr = bcFramePtr; - cleanup = 1; - pc += 1; - /* yield next instruction */ - TEBC_YIELD(); - /* add TEBCResume for this command */ - return TclNRExecuteByteCode(interp, - TclCompileObj(interp, OBJ_AT_TOS, NULL, 0)); + goto instEvalStk; } } -- cgit v0.12 From cf0b9b27229540852823f29cc7cbeeaa2be4c20c Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 27 Aug 2019 15:40:27 +0000 Subject: small amend: be sure checkInterp is set if entering back the code marked as TCL_BYTECODE_RECOMPILE (normally also set in CACHE_STACK_INFO, but...) --- generic/tclExecute.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index aff2c51..81173da 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -2168,7 +2168,7 @@ TEBCresume( int cleanup = PTR2INT(data[2]); Tcl_Obj *objResultPtr; - int checkInterp; /* Indicates when a check of interp readyness + int checkInterp = 0; /* Indicates when a check of interp readyness * is necessary. Set by CACHE_STACK_INFO() */ /* @@ -2203,7 +2203,6 @@ TEBCresume( if (!pc) { /* bytecode is starting from scratch */ - checkInterp = 0; pc = codePtr->codeStart; goto cleanup0; } else { @@ -2227,6 +2226,7 @@ TEBCresume( if (codePtr->flags & TCL_BYTECODE_RECOMPILE) { iPtr->flags |= ERR_ALREADY_LOGGED; codePtr->flags &= ~TCL_BYTECODE_RECOMPILE; + checkInterp = 1; } if (result != TCL_OK) { -- cgit v0.12 From e9a4ca4f22d40f304a6f50f9b410651ce75098cd Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 28 Aug 2019 09:59:26 +0000 Subject: Add /* FALLTHRU */ markers in various places (silencing possible GCC warnings). Eliminate some more "register" keywords. Eliminate (or silence) some unused function parameters. --- compat/zlib/contrib/minizip/crypt.h | 2 +- generic/regc_lex.c | 4 +--- generic/regc_nfa.c | 6 ++++++ generic/regcomp.c | 26 ++++---------------------- generic/regcustom.h | 4 ++-- generic/regerror.c | 1 - generic/regex.h | 4 ++-- generic/regexec.c | 8 +++----- generic/regguts.h | 2 +- generic/tclAssembly.c | 13 ++++++------- generic/tclBasic.c | 2 +- generic/tclCkalloc.c | 12 ++++++++++++ generic/tclClock.c | 5 +++++ generic/tclCmdMZ.c | 1 + generic/tclCompile.h | 8 ++++---- generic/tclDictObj.c | 1 + generic/tclExecute.c | 5 +++++ generic/tclOOInt.h | 2 +- generic/tclProc.c | 4 +--- generic/tclRegexp.c | 4 ++-- generic/tclScan.c | 11 +++++------ generic/tclStringObj.c | 2 ++ win/tclWinPipe.c | 1 + 23 files changed, 67 insertions(+), 61 deletions(-) diff --git a/compat/zlib/contrib/minizip/crypt.h b/compat/zlib/contrib/minizip/crypt.h index 1e9e820..ea8ba06 100644 --- a/compat/zlib/contrib/minizip/crypt.h +++ b/compat/zlib/contrib/minizip/crypt.h @@ -51,7 +51,7 @@ static int update_keys(unsigned long* pkeys,const z_crc_t* pcrc_32_tab,int c) (*(pkeys+1)) += (*(pkeys+0)) & 0xff; (*(pkeys+1)) = (*(pkeys+1)) * 134775813L + 1; { - register int keyshift = (int)((*(pkeys+1)) >> 24); + int keyshift = (int)((*(pkeys+1)) >> 24); (*(pkeys+2)) = CRC32((*(pkeys+2)), keyshift); } return c; diff --git a/generic/regc_lex.c b/generic/regc_lex.c index affcb48..fba2fc7 100644 --- a/generic/regc_lex.c +++ b/generic/regc_lex.c @@ -905,9 +905,7 @@ lexescape( v->now = save; - /* - * And fall through into octal number. - */ + /* FALLTHRU */ case CHR('0'): NOTE(REG_UUNPORT); diff --git a/generic/regc_nfa.c b/generic/regc_nfa.c index 088c6c0..7f43958 100644 --- a/generic/regc_nfa.c +++ b/generic/regc_nfa.c @@ -2978,6 +2978,9 @@ dumpnfa( dumpcolors(nfa->cm, f); } fflush(f); +#else + (void)nfa; + (void)f; #endif } @@ -3157,6 +3160,9 @@ dumpcnfa( dumpcstate(st, cnfa, f); } fflush(f); +#else + (void)cnfa; + (void)f; #endif } diff --git a/generic/regcomp.c b/generic/regcomp.c index 211cd70..3051446 100644 --- a/generic/regcomp.c +++ b/generic/regcomp.c @@ -59,7 +59,6 @@ static void wordchrs(struct vars *); static struct subre *subre(struct vars *, int, int, struct state *, struct state *); static void freesubre(struct vars *, struct subre *); static void freesrnode(struct vars *, struct subre *); -static void optst(struct vars *, struct subre *); static int numst(struct subre *, int); static void markst(struct subre *); static void cleanst(struct vars *); @@ -395,7 +394,6 @@ compile( dumpnfa(v->nfa, debug); dumpst(v->tree, debug, 1); } - optst(v, v->tree); v->ntree = numst(v->tree, 1); markst(v->tree); cleanst(v); @@ -923,7 +921,7 @@ parseqatom( */ NOTE(REG_UPBOTCH); - /* fallthrough into case PLAIN */ + /* FALLTHRU */ case PLAIN: onechr(v, v->nextvalue, lp, rp); okcolors(v->nfa, v->cm); @@ -1812,25 +1810,6 @@ freesrnode( } /* - - optst - optimize a subRE subtree - ^ static void optst(struct vars *, struct subre *); - */ -static void -optst( - struct vars *v, - struct subre *t) -{ - /* - * DGP (2007-11-13): I assume it was the programmer's intent to eventually - * come back and add code to optimize subRE trees, but the routine coded - * just spends effort traversing the tree and doing nothing. We can do - * nothing with less effort. - */ - - return; -} - -/* - numst - number tree nodes (assigning "id" indexes) ^ static int numst(struct subre *, int); */ @@ -2101,6 +2080,9 @@ dump( } fprintf(f, "\n"); dumpst(g->tree, f, 0); +#else + (void)re; + (void)f; #endif } diff --git a/generic/regcustom.h b/generic/regcustom.h index 681b97d..e7bdca7 100644 --- a/generic/regcustom.h +++ b/generic/regcustom.h @@ -132,7 +132,7 @@ typedef int celt; /* Type to hold chr, or NOCELT */ #if 1 #define AllocVars(vPtr) \ static Tcl_ThreadDataKey varsKey; \ - register struct vars *vPtr = (struct vars *) \ + struct vars *vPtr = (struct vars *) \ Tcl_GetThreadData(&varsKey, sizeof(struct vars)) #else /* @@ -141,7 +141,7 @@ typedef int celt; /* Type to hold chr, or NOCELT */ * faster in practice (measured!) */ #define AllocVars(vPtr) \ - register struct vars *vPtr = (struct vars *) MALLOC(sizeof(struct vars)) + struct vars *vPtr = (struct vars *) MALLOC(sizeof(struct vars)) #define FreeVars(vPtr) \ FREE(vPtr) #endif diff --git a/generic/regerror.c b/generic/regerror.c index 49d93ed..f783217 100644 --- a/generic/regerror.c +++ b/generic/regerror.c @@ -58,7 +58,6 @@ static const struct rerr { size_t /* Actual space needed (including NUL) */ regerror( int code, /* Error code, or REG_ATOI or REG_ITOA */ - const regex_t *preg, /* Associated regex_t (unused at present) */ char *errbuf, /* Result buffer (unless errbuf_size==0) */ size_t errbuf_size) /* Available space in errbuf, can be 0 */ { diff --git a/generic/regex.h b/generic/regex.h index 8845f72..adbd098 100644 --- a/generic/regex.h +++ b/generic/regex.h @@ -232,7 +232,7 @@ typedef struct { * of character is used for error reports is independent of what kind is used * in matching. * - ^ extern size_t regerror(int, const regex_t *, char *, size_t); + ^ extern size_t regerror(int, char *, size_t); */ #define REG_OKAY 0 /* no errors detected */ #define REG_NOMATCH 1 /* failed to match */ @@ -283,7 +283,7 @@ int regexec(regex_t *, const char *, size_t, regmatch_t [], int); MODULE_SCOPE int __REG_WIDE_EXEC(regex_t *, const __REG_WIDE_T *, size_t, rm_detail_t *, size_t, regmatch_t [], int); #endif MODULE_SCOPE void regfree(regex_t *); -MODULE_SCOPE size_t regerror(int, const regex_t *, char *, size_t); +MODULE_SCOPE size_t regerror(int, char *, size_t); /* automatically gathered by fwd; do not hand-edit */ /* =====^!^===== end forwards =====^!^===== */ diff --git a/generic/regexec.c b/generic/regexec.c index 6d12827..f174420 100644 --- a/generic/regexec.c +++ b/generic/regexec.c @@ -129,7 +129,7 @@ int exec(regex_t *, const chr *, size_t, rm_detail_t *, size_t, regmatch_t [], i static struct dfa *getsubdfa(struct vars *, struct subre *); static int simpleFind(struct vars *const, struct cnfa *const, struct colormap *const); static int complicatedFind(struct vars *const, struct cnfa *const, struct colormap *const); -static int complicatedFindLoop(struct vars *const, struct cnfa *const, struct colormap *const, struct dfa *const, struct dfa *const, chr **const); +static int complicatedFindLoop(struct vars *const, struct dfa *const, struct dfa *const, chr **const); static void zapallsubs(regmatch_t *const, const size_t); static void zaptreesubs(struct vars *const, struct subre *const); static void subset(struct vars *const, struct subre *const, chr *const, chr *const); @@ -434,7 +434,7 @@ complicatedFind( return v->err; } - ret = complicatedFindLoop(v, cnfa, cm, d, s, &cold); + ret = complicatedFindLoop(v, d, s, &cold); freeDFA(d); freeDFA(s); @@ -453,14 +453,12 @@ complicatedFind( /* - complicatedFindLoop - the heart of complicatedFind - ^ static int complicatedFindLoop(struct vars *, struct cnfa *, struct colormap *, + ^ static int complicatedFindLoop(struct vars *, ^ struct dfa *, struct dfa *, chr **); */ static int complicatedFindLoop( struct vars *const v, - struct cnfa *const cnfa, - struct colormap *const cm, struct dfa *const d, struct dfa *const s, chr **const coldp) /* where to put coldstart pointer */ diff --git a/generic/regguts.h b/generic/regguts.h index 1ac2465..e10711d 100644 --- a/generic/regguts.h +++ b/generic/regguts.h @@ -438,7 +438,7 @@ struct guts { #ifndef AllocVars #define AllocVars(vPtr) \ struct vars var; \ - register struct vars *vPtr = &var + struct vars *vPtr = &var #endif #ifndef FreeVars #define FreeVars(vPtr) ((void) 0) diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index 39930a7..f05814fa 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -287,8 +287,7 @@ static int GetIntegerOperand(AssemblyEnv*, Tcl_Token**, int*); static int GetNextOperand(AssemblyEnv*, Tcl_Token**, Tcl_Obj**); static void LookForFreshCatches(BasicBlock*, BasicBlock**); static void MoveCodeForJumps(AssemblyEnv*, int); -static void MoveExceptionRangesToBasicBlock(AssemblyEnv*, int, - int); +static void MoveExceptionRangesToBasicBlock(AssemblyEnv*, int); static AssemblyEnv* NewAssemblyEnv(CompileEnv*, int); static int ProcessCatches(AssemblyEnv*); static int ProcessCatchesInBasicBlock(AssemblyEnv*, BasicBlock*, @@ -784,6 +783,7 @@ TclNRAssembleObjCmd( Tcl_Obj* backtrace; /* Object where extra error information is * constructed. */ + (void)dummy; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "bytecodeList"); return TCL_ERROR; @@ -959,7 +959,7 @@ TclCompileAssembleCmd( int numCommands = envPtr->numCommands; int offset = envPtr->codeNext - envPtr->codeStart; int depth = envPtr->currStackDepth; - + (void)cmdPtr; /* * Make sure that the command has a single arg that is a simple word. */ @@ -1808,7 +1808,6 @@ CompileEmbeddedScript( int savedStackDepth = envPtr->currStackDepth; int savedMaxStackDepth = envPtr->maxStackDepth; - int savedCodeIndex = envPtr->codeNext - envPtr->codeStart; int savedExceptArrayNext = envPtr->exceptArrayNext; envPtr->currStackDepth = 0; @@ -1841,8 +1840,7 @@ CompileEmbeddedScript( * need to be fixed up once the stack depth is known. */ - MoveExceptionRangesToBasicBlock(assemEnvPtr, savedCodeIndex, - savedExceptArrayNext); + MoveExceptionRangesToBasicBlock(assemEnvPtr, savedExceptArrayNext); /* * Flush the current basic block. @@ -1901,7 +1899,6 @@ SyncStackDepth( static void MoveExceptionRangesToBasicBlock( AssemblyEnv* assemEnvPtr, /* Assembly environment */ - int savedCodeIndex, /* Start of the embedded code */ int savedExceptArrayNext) /* Saved index of the end of the exception * range array */ { @@ -4310,6 +4307,8 @@ DupAssembleCodeInternalRep( Tcl_Obj *srcPtr, Tcl_Obj *copyPtr) { + (void)srcPtr; + (void)copyPtr; return; } diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 62e7e04..53d1158 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -6510,8 +6510,8 @@ Tcl_ExprLongObj( return TCL_ERROR; } resultPtr = Tcl_NewBignumObj(&big); - /* FALLTHROUGH */ } + /* FALLTHRU */ case TCL_NUMBER_LONG: case TCL_NUMBER_WIDE: case TCL_NUMBER_BIG: diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index 70e64f0..26f092f 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -1119,6 +1119,8 @@ Tcl_AttemptDbCkalloc( int line) { char *result; + (void)file; + (void)line; result = (char *) TclpAlloc(size); return result; @@ -1198,6 +1200,8 @@ Tcl_AttemptDbCkrealloc( int line) { char *result; + (void)file; + (void)line; result = (char *) TclpRealloc(ptr, size); return result; @@ -1228,6 +1232,8 @@ Tcl_DbCkfree( const char *file, int line) { + (void)file; + (void)line; TclpFree(ptr); } @@ -1246,12 +1252,14 @@ void Tcl_InitMemory( Tcl_Interp *interp) { + (void)interp; } int Tcl_DumpActiveMemory( const char *fileName) { + (void)fileName; return TCL_OK; } @@ -1260,6 +1268,8 @@ Tcl_ValidateAllMemory( const char *file, int line) { + (void)file; + (void)line; } int @@ -1267,6 +1277,8 @@ TclDumpMemoryInfo( ClientData clientData, int flags) { + (void)clientData; + (void)flags; return 1; } diff --git a/generic/tclClock.c b/generic/tclClock.c index 9ed970c..0e8a941 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -1652,6 +1652,7 @@ ClockGetenvObjCmd( { const char *varName; const char *varValue; + (void)clientData; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); @@ -1744,6 +1745,7 @@ ClockClicksObjCmd( int index = CLICKS_NATIVE; Tcl_Time now; Tcl_WideInt clicks = 0; + (void)clientData; switch (objc) { case 1: @@ -1806,6 +1808,7 @@ ClockMillisecondsObjCmd( Tcl_Obj *const *objv) /* Parameter values */ { Tcl_Time now; + (void)clientData; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); @@ -1842,6 +1845,7 @@ ClockMicrosecondsObjCmd( int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter values */ { + (void)clientData; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; @@ -1994,6 +1998,7 @@ ClockSecondsObjCmd( Tcl_Obj *const *objv) /* Parameter values */ { Tcl_Time now; + (void)clientData; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index ae10e74..193eac4 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -4578,6 +4578,7 @@ Tcl_TimeRateObjCmd( */ threshold = 1; maxcnt = 0; + /* FALLTHRU */ case TCL_CONTINUE: result = TCL_OK; break; diff --git a/generic/tclCompile.h b/generic/tclCompile.h index aa6d247..1d657a7 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -1164,14 +1164,14 @@ MODULE_SCOPE void TclPushVarName(Tcl_Interp *interp, static inline void TclPreserveByteCode( - register ByteCode *codePtr) + ByteCode *codePtr) { codePtr->refCount++; } static inline void TclReleaseByteCode( - register ByteCode *codePtr) + ByteCode *codePtr) { if (codePtr->refCount-- > 1) { return; @@ -1209,7 +1209,7 @@ MODULE_SCOPE Tcl_Obj *TclGetInnerContext(Tcl_Interp *interp, const unsigned char *pc, Tcl_Obj **tosPtr); MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData, - register Tcl_Interp *interp, int objc, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int isLambda); @@ -1420,7 +1420,7 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData, #define TclEmitPush(objIndex, envPtr) \ do { \ - register int _objIndexCopy = (objIndex); \ + int _objIndexCopy = (objIndex); \ if (_objIndexCopy <= 255) { \ TclEmitInstInt1(INST_PUSH1, _objIndexCopy, (envPtr)); \ } else { \ diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 32234a3..a42c123 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -3083,6 +3083,7 @@ DictFilterCmd( Tcl_ResetResult(interp); Tcl_DictObjDone(&search); + /* FALLTHRU */ case TCL_CONTINUE: result = TCL_OK; break; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 779f4a2..c5f5c0c 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -2286,10 +2286,12 @@ TEBCresume( objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); } + /* FALLTHRU */ case 2: cleanup2_pushObjResultPtr: objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); + /* FALLTHRU */ case 1: cleanup1_pushObjResultPtr: objPtr = OBJ_AT_TOS; @@ -2306,14 +2308,17 @@ TEBCresume( objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); } + /* FALLTHRU */ case 2: cleanup2: objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); + /* FALLTHRU */ case 1: cleanup1: objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); + /* FALLTHRU */ case 0: /* * We really want to do nothing now, but this is needed for some diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index d90b407..436acd6 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -590,7 +590,7 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr); #undef DUPLICATE /* prevent possible conflict with definition in WINAPI nb30.h */ #define DUPLICATE(target,source,type) \ do { \ - register unsigned len = sizeof(type) * ((target).num=(source).num);\ + size_t len = sizeof(type) * ((target).num=(source).num);\ if (len != 0) { \ memcpy(((target).list=(type*)ckalloc(len)), (source).list, len); \ } else { \ diff --git a/generic/tclProc.c b/generic/tclProc.c index 03cb0f0..06ca565 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -1835,9 +1835,7 @@ InterpProcNR2( Tcl_SetErrorCode(interp, "TCL", "RESULT", "UNEXPECTED", NULL); result = TCL_ERROR; - /* - * Fall through to the TCL_ERROR handling code. - */ + /* FALLTHRU */ case TCL_ERROR: /* diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c index cfe6388..19ff8fd 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.c @@ -726,12 +726,12 @@ TclRegError( const char *p; Tcl_ResetResult(interp); - n = TclReError(status, NULL, buf, sizeof(buf)); + n = TclReError(status, buf, sizeof(buf)); p = (n > sizeof(buf)) ? "..." : ""; Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s%s%s", msg, buf, p)); sprintf(cbuf, "%d", status); - (void) TclReError(REG_ITOA, NULL, cbuf, sizeof(cbuf)); + (void) TclReError(REG_ITOA, cbuf, sizeof(cbuf)); Tcl_SetErrorCode(interp, "REGEXP", cbuf, buf, NULL); } diff --git a/generic/tclScan.c b/generic/tclScan.c index 1ff83af..b0669ab 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -362,8 +362,10 @@ ValidateFormat( format += TclUtfToUniChar(format, &ch); break; } + /* FALLTHRU */ case 'L': flags |= SCAN_LONGER; + /* FALLTHRU */ case 'h': format += TclUtfToUniChar(format, &ch); } @@ -385,9 +387,7 @@ ValidateFormat( Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADWIDTH", NULL); goto error; } - /* - * Fall through! - */ + /* FALLTHRU */ case 'n': case 's': if (flags & (SCAN_LONGER|SCAN_BIG)) { @@ -709,11 +709,10 @@ Tcl_ScanObjCmd( format += TclUtfToUniChar(format, &ch); break; } + /* FALLTHRU */ case 'L': flags |= SCAN_LONGER; - /* - * Fall through so we skip to the next character. - */ + /* FALLTHRU */ case 'h': format += TclUtfToUniChar(format, &ch); } diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index ad578b1..e4db140 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -2019,6 +2019,7 @@ Tcl_AppendFormatToObj( errCode = "BADUNSIGNED"; goto errorMsg; } + /* FALLTHRU */ case 'd': case 'o': case 'x': @@ -2616,6 +2617,7 @@ AppendPrintfToObjVA( break; case 'h': size = -1; + /* FALLTHRU */ default: p++; } diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index ce3e746..d8e96d5 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -3447,6 +3447,7 @@ TclPipeThreadStopSignal( SetEvent(evControl); *pipeTIPtr = NULL; + /* FALLTHRU */ case PTI_STATE_DOWN: return 1; -- cgit v0.12 From 2b73734be07786688a331c6458afb5610e4c75c9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 29 Aug 2019 07:42:50 +0000 Subject: Starting with Tcl 8.7, TCL_THREADS is 1 by default. Adapt rules.vc for that. --- win/rules.vc | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/win/rules.vc b/win/rules.vc index 4a1402a..ba59a96 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -994,7 +994,7 @@ VERSION = $(DOTVERSION:.=) # different compilers, build configurations etc., # # Naming convention (suffixes): -# t = full thread support. +# t = full thread support. (Not used for Tcl >= 8.7) # s = static library (as opposed to an import library) # g = linked to the debug enabled C run-time. # x = special static build when it links to the dynamic C run-time. @@ -1052,7 +1052,7 @@ SUFX = $(SUFX:x=) !endif !endif -!if !$(TCL_THREADS) +!if !$(TCL_THREADS) || $(TCL_VERSION) > 86 TMP_DIRFULL = $(TMP_DIRFULL:Threaded=) SUFX = $(SUFX:t=) !endif @@ -1293,7 +1293,7 @@ OPTDEFINES = $(OPTDEFINES) -DTCL_MEM_DEBUG !if $(TCL_COMPILE_DEBUG) OPTDEFINES = $(OPTDEFINES) -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS !endif -!if $(TCL_THREADS) +!if $(TCL_THREADS) && $(TCL_VERSION) <= 86 OPTDEFINES = $(OPTDEFINES) -DTCL_THREADS=1 !if $(USE_THREAD_ALLOC) OPTDEFINES = $(OPTDEFINES) -DUSE_THREAD_ALLOC=1 @@ -1537,8 +1537,8 @@ RESCMD = $(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" \ -DDOTVERSION=\"$(DOTVERSION)\" \ -DVERSION=\"$(VERSION)\" \ -DSUFX=\"$(SUFX)\" \ - -DPROJECT=\"$(PROJECT)\" \ - -DPRJLIBNAME=\"$(PRJLIBNAME)\" + -DPROJECT=\"$(PROJECT)\" \ + -DPRJLIBNAME=\"$(PRJLIBNAME)\" !ifndef DEFAULT_BUILD_TARGET DEFAULT_BUILD_TARGET = $(PROJECT) -- cgit v0.12 From 1b753c8466656164d5c49f1565a6e29cd9039e84 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Thu, 29 Aug 2019 10:16:36 +0000 Subject: Bug fix 889065786b. Add stubs related flags when compiling extension stubs. --- win/rules.vc | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/win/rules.vc b/win/rules.vc index ba59a96..b1a0346 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -24,7 +24,7 @@ _RULES_VC = 1 # For modifications that are not backward-compatible, you *must* change # the major version. RULES_VERSION_MAJOR = 1 -RULES_VERSION_MINOR = 3 +RULES_VERSION_MINOR = 4 # The PROJECT macro must be defined by parent makefile. !if "$(PROJECT)" == "" @@ -1439,8 +1439,8 @@ cflags = -nologo -c $(COMPILERFLAGS) $(carch) $(cwarn) -Fp$(TMP_DIR)^\ $(cdebug) # BUILD_$(PROJECT) macro which should be defined only for the shared # library *implementation* and not for its caller interface -appcflags = $(cflags) $(crt) $(INCLUDES) $(TCL_DEFINES) $(PRJ_DEFINES) $(OPTDEFINES) $(USE_STUBS_DEFS) appcflags_nostubs = $(cflags) $(crt) $(INCLUDES) $(TCL_DEFINES) $(PRJ_DEFINES) $(OPTDEFINES) +appcflags = $(appcflags_nostubs) $(USE_STUBS_DEFS) pkgcflags = $(appcflags) $(PKGNAMEFLAGS) -DBUILD_$(PROJECT) pkgcflags_nostubs = $(appcflags_nostubs) $(PKGNAMEFLAGS) -DBUILD_$(PROJECT) @@ -1455,7 +1455,7 @@ pkgcflags_nostubs = $(appcflags_nostubs) $(PKGNAMEFLAGS) -DBUILD_$(PROJECT) # so we do not remove it from cflags. -GL may prevent extensions # compiled with one VC version to fail to link against stubs library # compiled with another VC version. Check for this and fix accordingly. -stubscflags = $(cflags) $(PKGNAMEFLAGS) $(PRJ_DEFINES) $(OPTDEFINES) -Zl -DSTATIC_BUILD $(INCLUDES) +stubscflags = $(cflags) $(PKGNAMEFLAGS) $(PRJ_DEFINES) $(OPTDEFINES) -Zl -DSTATIC_BUILD $(INCLUDES) $(USE_STUBS_DEFS) # Link flags -- cgit v0.12 From ee6b2e34559aa9915b480794418f1db489d723a8 Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 29 Aug 2019 20:28:47 +0000 Subject: add test cases covering nested compilation bug [fec0c17d39] (8.5 is not affected at the moment by nested count under 2500) --- tests/compile.test | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/tests/compile.test b/tests/compile.test index 7646c12..c9f1b71 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -422,6 +422,37 @@ test compile-13.1 {testing underestimate of maxStackSize in list cmd} {exec} { list [catch {exec [interpreter] << $script} msg] $msg } {0 OK} +# Tests of nested compile (body in body compilation), should not generate stack overflow +# (with abnormal program termination), bug [fec0c17d39]: +test compile-13.2 {TclCompileScript: testing nested scripts compilation} -setup { + set i [interp create] + interp recursionlimit $i [expr {10000+50}] + $i eval {proc gencode {nr {cmd eval} {nl 0}} { + set code "" + set e ""; if {$nl} {set e "\n"} + for {set i 0} {$i < $nr} {incr i} { + append code "$cmd \{$e" + } + append code "lappend result 1$e" + for {set i 0} {$i < $nr} {incr i} { + append code "\}$e" + } + #puts [format "%% %.40s ... %d bytes" $code [string length $code]] + return $code + }} +} -body { + # Test different compilation variants (instructions evalStk, invokeStk, etc), + # with 2000 nested scripts (bodies). If you get SO/SF exceptions on some low-stack + # boxes or systems, please don't decrease it (either provide a constraint) + $i eval {foreach cmd {eval "if 1" catch} { + set c [gencode 2000 $cmd] + if 1 $c + }} + $i eval {set result} +} -result {1 1 1} -cleanup { + interp delete $i +} + # Tests compile-14.* for [Bug 599788] [Bug 0c043a175a47da8c2342] test compile-14.1 {testing errors in element name; segfault?} {} { catch {set a([error])} msg1 -- cgit v0.12 From 87e3efddb07fb90ce44be9869ca883a896f1b122 Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 29 Aug 2019 20:46:46 +0000 Subject: more variants in test (since 8.6 compiles "try" using evalStk instruction) --- tests/compile.test | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/compile.test b/tests/compile.test index c651804..ee95d25 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -488,12 +488,12 @@ test compile-13.2 {TclCompileScript: testing nested scripts compilation} -setup # Test different compilation variants (instructions evalStk, invokeStk, etc), # with 2000 nested scripts (bodies). If you get SO/SF exceptions on some low-stack # boxes or systems, please don't decrease it (either provide a constraint) - $i eval {foreach cmd {eval "if 1" catch} { + $i eval {foreach cmd {eval "if 1" try catch} { set c [gencode 2000 $cmd] if 1 $c }} $i eval {set result} -} -result {1 1 1} -cleanup { +} -result {1 1 1 1} -cleanup { interp delete $i } -- cgit v0.12 From 7efc804258d3dcc195a86386704ed09e7691d9fe Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 29 Aug 2019 20:50:31 +0000 Subject: closes [fec0c17d39]: fixed stack overflow (followed by SF) by compilation of too many nested bodies (don't use system stack, size of Tcl_Parse is ca. 400 bytes and compiler proc's of commands are reserving stack too) --- generic/tclCompile.c | 47 +++++++++++++++++++++++++++++------------------ 1 file changed, 29 insertions(+), 18 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 6f90072..87f1bfc 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -2128,18 +2128,26 @@ TclCompileScript( /* Each iteration compiles one command from the script. */ - while (numBytes > 0) { - Tcl_Parse parse; + if (numBytes > 0) { + /* + * Don't use system stack (size of Tcl_Parse is ca. 400 bytes), so + * many nested compilations (body enclosed in body) can cause abnormal + * program termination with a stack overflow exception, bug [fec0c17d39]. + */ + Tcl_Parse *parsePtr = ckalloc(sizeof(Tcl_Parse)); + + do { const char *next; - if (TCL_OK != Tcl_ParseCommand(interp, p, numBytes, 0, &parse)) { + if (TCL_OK != Tcl_ParseCommand(interp, p, numBytes, 0, parsePtr)) { /* - * Compile bytecodes to report the parse error at runtime. + * Compile bytecodes to report the parsePtr error at runtime. */ - Tcl_LogCommandInfo(interp, script, parse.commandStart, - parse.term + 1 - parse.commandStart); + Tcl_LogCommandInfo(interp, script, parsePtr->commandStart, + parsePtr->term + 1 - parsePtr->commandStart); TclCompileSyntaxError(interp, envPtr); + ckfree(parsePtr); return; } @@ -2150,9 +2158,9 @@ TclCompileScript( */ if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) { - int commandLength = parse.term - parse.commandStart; + int commandLength = parsePtr->term - parsePtr->commandStart; fprintf(stdout, " Compiling: "); - TclPrintSource(stdout, parse.commandStart, + TclPrintSource(stdout, parsePtr->commandStart, TclMin(commandLength, 55)); fprintf(stdout, "\n"); } @@ -2163,48 +2171,51 @@ TclCompileScript( * (See test info-30.33). */ - TclAdvanceLines(&envPtr->line, p, parse.commandStart); + TclAdvanceLines(&envPtr->line, p, parsePtr->commandStart); TclAdvanceContinuations(&envPtr->line, &envPtr->clNext, - parse.commandStart - envPtr->source); + parsePtr->commandStart - envPtr->source); /* * Advance parser to the next command in the script. */ - next = parse.commandStart + parse.commandSize; + next = parsePtr->commandStart + parsePtr->commandSize; numBytes -= next - p; p = next; - if (parse.numWords == 0) { + if (parsePtr->numWords == 0) { /* * The "command" parsed has no words. In this case we can skip * the rest of the loop body. With no words, clearly * CompileCommandTokens() has nothing to do. Since the parser * aggressively sucks up leading comment and white space, - * including newlines, parse.commandStart must be pointing at + * including newlines, parsePtr->commandStart must be pointing at * either the end of script, or a command-terminating semi-colon. * In either case, the TclAdvance*() calls have nothing to do. * Finally, when no words are parsed, no tokens have been - * allocated at parse.tokenPtr so there's also nothing for + * allocated at parsePtr->tokenPtr so there's also nothing for * Tcl_FreeParse() to do. * * The advantage of this shortcut is that CompileCommandTokens() - * can be written with an assumption that parse.numWords > 0, with + * can be written with an assumption that parsePtr->numWords > 0, with * the implication the CCT() always generates bytecode. */ continue; } - lastCmdIdx = CompileCommandTokens(interp, &parse, envPtr); + lastCmdIdx = CompileCommandTokens(interp, parsePtr, envPtr); /* * TIP #280: Track lines in the just compiled command. */ - TclAdvanceLines(&envPtr->line, parse.commandStart, p); + TclAdvanceLines(&envPtr->line, parsePtr->commandStart, p); TclAdvanceContinuations(&envPtr->line, &envPtr->clNext, p - envPtr->source); - Tcl_FreeParse(&parse); + Tcl_FreeParse(parsePtr); + } while (numBytes > 0); + + ckfree(parsePtr); } if (lastCmdIdx == -1) { -- cgit v0.12 From 6e297fef1f383d6ca3c7bf090b0351ad9f30aabc Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 30 Aug 2019 16:33:33 +0000 Subject: compile.test: reduce count of nested scripts to 1000 in debug case (seems to be to heavy on some platforms within debug-build); (small amend to the fix of [fec0c17d39]) --- tests/compile.test | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/compile.test b/tests/compile.test index c9f1b71..c02acdb 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -442,10 +442,10 @@ test compile-13.2 {TclCompileScript: testing nested scripts compilation} -setup }} } -body { # Test different compilation variants (instructions evalStk, invokeStk, etc), - # with 2000 nested scripts (bodies). If you get SO/SF exceptions on some low-stack + # with 2000 (1000 in debug) nested scripts (bodies). If you get SO/SF exceptions on some low-stack # boxes or systems, please don't decrease it (either provide a constraint) $i eval {foreach cmd {eval "if 1" catch} { - set c [gencode 2000 $cmd] + set c [gencode [expr {![info exists ::tcl_platform(debug)] ? 2000 : 1000}] $cmd] if 1 $c }} $i eval {set result} -- cgit v0.12 From 2bfd0ac419cf53496ab8ab6545c83626f9b6879c Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 30 Aug 2019 19:48:04 +0000 Subject: extends [fec0c17d39]: restrict nested compilations using same limit (interp recursionlimit) like the evaluation, this must protect against unexpected stack exhaustion (avoid SO by deeply recursive call stack) --- generic/tclCompile.c | 23 +++++++++++++++++++++++ tests/compile.test | 46 ++++++++++++++++++++++++++++++++++++++-------- 2 files changed, 61 insertions(+), 8 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 87f1bfc..1a7d32f 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -2121,10 +2121,25 @@ TclCompileScript( * has not yet generated any bytecode. */ const char *p = script; /* Where we are in our compile. */ int depth = TclGetStackDepth(envPtr); + Interp *iPtr = (Interp *) interp; if (envPtr->iPtr == NULL) { Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv"); } + /* + * Check depth to avoid SO by too many nested calls of TclCompileScript + * (considering interp recursionlimit). + * Factor 5/4 (1.25) is used to avoid too mistaken limit recognition + * during "mixed" evaluation and compilation process (nested eval+compile) + * and is good enough for default recursionlimit (1000). + */ + if (iPtr->numLevels / 5 > iPtr->maxNestingDepth / 4) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "too many nested compilations (infinite loop?)", -1)); + Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", NULL); + TclCompileSyntaxError(interp, envPtr); + return; + } /* Each iteration compiles one command from the script. */ @@ -2203,8 +2218,16 @@ TclCompileScript( continue; } + /* + * Avoid stack exhaustion by too many nested calls of TclCompileScript + * (considering interp recursionlimit). + */ + iPtr->numLevels++; + lastCmdIdx = CompileCommandTokens(interp, parsePtr, envPtr); + iPtr->numLevels--; + /* * TIP #280: Track lines in the just compiled command. */ diff --git a/tests/compile.test b/tests/compile.test index 548454b..89fe8dc 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -468,10 +468,13 @@ test compile-13.1 {testing underestimate of maxStackSize in list cmd} {exec} { # Tests of nested compile (body in body compilation), should not generate stack overflow # (with abnormal program termination), bug [fec0c17d39]: -test compile-13.2 {TclCompileScript: testing nested scripts compilation} -setup { - set i [interp create] - interp recursionlimit $i [expr {10000+50}] - $i eval {proc gencode {nr {cmd eval} {nl 0}} { +proc _ti_gencode {} { + # creates test interpreter on demand with [gencode] generator: + if {[interp exists ti]} { + return + } + interp create ti + ti eval {proc gencode {nr {cmd eval} {nl 0}} { set code "" set e ""; if {$nl} {set e "\n"} for {set i 0} {$i < $nr} {incr i} { @@ -484,18 +487,45 @@ test compile-13.2 {TclCompileScript: testing nested scripts compilation} -setup #puts [format "%% %.40s ... %d bytes" $code [string length $code]] return $code }} +} +test compile-13.2 {TclCompileScript: testing expected nested scripts compilation} -setup { + _ti_gencode + interp recursionlimit ti [expr {10000+50}] + ti eval {set result {}} } -body { # Test different compilation variants (instructions evalStk, invokeStk, etc), # with 2000 (1000 in debug) nested scripts (bodies). If you get SO/SF exceptions on some low-stack # boxes or systems, please don't decrease it (either provide a constraint) - $i eval {foreach cmd {eval "if 1" try catch} { + ti eval {foreach cmd {eval "if 1" try catch} { set c [gencode [expr {![info exists ::tcl_platform(debug)] ? 2000 : 1000}] $cmd] if 1 $c }} - $i eval {set result} -} -result {1 1 1 1} -cleanup { - interp delete $i + ti eval {set result} +} -result {1 1 1 1} +test compile-13.3 {TclCompileScript: testing check of max depth by nested scripts compilation} -setup { + _ti_gencode + interp recursionlimit ti 100 + ti eval {set result {}} +} -body { + # Test different compilation variants (instructions evalStk, invokeStk, etc), + # with 500 nested scripts (bodies). It must generate "too many nested compilations" + # error for any variant we're testing here: + ti eval {foreach cmd {eval "if 1" try catch} { + set c [gencode [expr {![info exists ::tcl_platform(debug)] ? 2000 : 1000}] $cmd] + lappend errors [catch $c e] $e + }} + #puts $errors + # all of nested calls exceed the limit, so must end with "too many nested compilations" + # (or evaluations, depending on compile method/instruction and "mixed" compile within + # evaliation), so no one succeeds, the result must be empty: + ti eval {set result} +} -result {} +# +# clean up: +if {[interp exists ti]} { + interp delete ti } +rename _ti_gencode {} # Tests compile-14.* for [Bug 599788] [Bug 0c043a175a47da8c2342] test compile-14.1 {testing errors in element name; segfault?} {} { -- cgit v0.12 From 7e14ee0b34c8b10709252eaf40b6201681bfb7f4 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 2 Sep 2019 08:28:39 +0000 Subject: Fix [5591e4a820]: @TCL_EXE@ not properly generated in 8.5 branch. Added @runstatedir@ in Makefile.in, not used yet (except if someone decides to re-generate "configure" with autconf-2.70). --- unix/configure | 2 +- win/Makefile.in | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/unix/configure b/unix/configure index 1e15a25..aedf8ff 100755 --- a/unix/configure +++ b/unix/configure @@ -18312,7 +18312,7 @@ echo "${ECHO_T}$tcl_ok" >&6 #------------------------------------------------------------------------ # Check whether the timezone data is supplied by the OS or has # to be installed by Tcl. The default is autodetection, but can -# be overriden on the configure command line either way. +# be overridden on the configure command line either way. #------------------------------------------------------------------------ echo "$as_me:$LINENO: checking for timezone data" >&5 diff --git a/win/Makefile.in b/win/Makefile.in index dbe8df2..6f2044f5 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -23,6 +23,7 @@ bindir = @bindir@ libdir = @libdir@ includedir = @includedir@ datarootdir = @datarootdir@ +runstatedir = @runstatedir@ mandir = @mandir@ # The following definition can be set to non-null for special systems like AFS @@ -163,7 +164,7 @@ MAN2TCL = man2tcl$(EXEEXT) # (make genstubs, make install) need it to be available on the PATH. This # executable should *NOT* be required just to do a normal build although # it can be required to run make dist. -TCL_EXE = @TCL_EXE@ +TCL_EXE = tclsh @SET_MAKE@ -- cgit v0.12 From 6f79cd18d73ff8505c57c11805d5476bc398e8ac Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 2 Sep 2019 11:07:46 +0000 Subject: Missing TCL_GLOBAL_ONLY flag in VwaitVarProc(): vwait always references global variables, this could lead to strange side-effects. --- generic/tclEvent.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 4db524c..0fed0a8 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -1379,7 +1379,8 @@ VwaitVarProc( int *donePtr = (int *) clientData; *donePtr = 1; - Tcl_UntraceVar(interp, name1, TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + Tcl_UntraceVar2(interp, name1, name2, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VwaitVarProc, clientData); return NULL; } -- cgit v0.12 From 4376455cb3f94b4d49e5dd9a42fc1c4549fc23e5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 2 Sep 2019 11:33:06 +0000 Subject: Tcl_UntraceVar() -> Tcl_UntraceVar2() and similar changes. Add @runstatedir@ to Makefile.in's (not used yet) --- generic/tclDictObj.c | 2 +- generic/tclEvent.c | 3 ++- generic/tclInterp.c | 8 ++++---- unix/Makefile.in | 1 + unix/configure | 2 +- win/Makefile.in | 1 + 6 files changed, 10 insertions(+), 7 deletions(-) diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 1952778..083af70 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -3310,7 +3310,7 @@ DictUpdateCmd( } if (objPtr == NULL) { /* ??? */ - Tcl_UnsetVar(interp, Tcl_GetString(objv[i+1]), 0); + Tcl_UnsetVar2(interp, Tcl_GetString(objv[i+1]), NULL, 0); } else if (Tcl_ObjSetVar2(interp, objv[i+1], NULL, objPtr, TCL_LEAVE_ERR_MSG) == NULL) { TclDecrRefCount(dictPtr); diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 734f114..571885f 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -1472,7 +1472,8 @@ VwaitVarProc( int *donePtr = clientData; *donePtr = 1; - Tcl_UntraceVar(interp, name1, TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + Tcl_UntraceVar2(interp, name1, NULL, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VwaitVarProc, clientData); return NULL; } diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 3188fce..bd786f3 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -3291,7 +3291,7 @@ Tcl_MakeSafe( * No env array in a safe slave. */ - Tcl_UnsetVar(interp, "env", TCL_GLOBAL_ONLY); + Tcl_UnsetVar2(interp, "env", NULL, TCL_GLOBAL_ONLY); /* * Remove unsafe parts of tcl_platform @@ -3307,9 +3307,9 @@ Tcl_MakeSafe( * nameofexecutable]) */ - Tcl_UnsetVar(interp, "tclDefaultLibrary", TCL_GLOBAL_ONLY); - Tcl_UnsetVar(interp, "tcl_library", TCL_GLOBAL_ONLY); - Tcl_UnsetVar(interp, "tcl_pkgPath", TCL_GLOBAL_ONLY); + Tcl_UnsetVar2(interp, "tclDefaultLibrary", NULL, TCL_GLOBAL_ONLY); + Tcl_UnsetVar2(interp, "tcl_library", NULL, TCL_GLOBAL_ONLY); + Tcl_UnsetVar2(interp, "tcl_pkgPath", NULL, TCL_GLOBAL_ONLY); /* * Remove the standard channels from the interpreter; safe interpreters do diff --git a/unix/Makefile.in b/unix/Makefile.in index 0afd069..c62a31e 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -28,6 +28,7 @@ bindir = @bindir@ libdir = @libdir@ includedir = @includedir@ datarootdir = @datarootdir@ +runstatedir = @runstatedir@ mandir = @mandir@ # The following definition can be set to non-null for special systems like AFS diff --git a/unix/configure b/unix/configure index bf00034..e0df311 100755 --- a/unix/configure +++ b/unix/configure @@ -9823,7 +9823,7 @@ $as_echo "$tcl_ok" >&6; } #------------------------------------------------------------------------ # Check whether the timezone data is supplied by the OS or has # to be installed by Tcl. The default is autodetection, but can -# be overriden on the configure command line either way. +# be overridden on the configure command line either way. #------------------------------------------------------------------------ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for timezone data" >&5 diff --git a/win/Makefile.in b/win/Makefile.in index c9ef05b..7bc4c1d 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -23,6 +23,7 @@ bindir = @bindir@ libdir = @libdir@ includedir = @includedir@ datarootdir = @datarootdir@ +runstatedir = @runstatedir@ mandir = @mandir@ # The following definition can be set to non-null for special systems like AFS -- cgit v0.12 From dfb98f070561139ccf2d88b30fb134de3c3fcac4 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 2 Sep 2019 13:48:52 +0000 Subject: windows (mingw build): fix debug recognition (::tcl_platform(debug)), no debug if NDEBUG is set --- win/nmakehlp.c | 2 +- win/tclWinInit.c | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/win/nmakehlp.c b/win/nmakehlp.c index c21de63..fac32ee 100644 --- a/win/nmakehlp.c +++ b/win/nmakehlp.c @@ -643,7 +643,7 @@ SubstituteFile( } /* debug: dump the list */ -#ifdef _DEBUG +#ifndef NDEBUG { int n = 0; list_item_t *p = NULL; diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 308d3f3..0574c37 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -602,7 +602,7 @@ TclpSetVariables( TCL_GLOBAL_ONLY); } -#ifdef _DEBUG +#ifndef NDEBUG /* * The existence of the "debug" element of the tcl_platform array * indicates that this particular Tcl shell has been compiled with debug -- cgit v0.12 From 07e8d24c838bb5f328de852deb361f3780d602fb Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 2 Sep 2019 14:13:33 +0000 Subject: Fix testing for debug build on UNIX too (on UNIX, ::tcl_platform(debug) is not set ....) --- tests/compile.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/compile.test b/tests/compile.test index 548454b..3b91a5c 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -489,7 +489,7 @@ test compile-13.2 {TclCompileScript: testing nested scripts compilation} -setup # with 2000 (1000 in debug) nested scripts (bodies). If you get SO/SF exceptions on some low-stack # boxes or systems, please don't decrease it (either provide a constraint) $i eval {foreach cmd {eval "if 1" try catch} { - set c [gencode [expr {![info exists ::tcl_platform(debug)] ? 2000 : 1000}] $cmd] + set c [gencode [expr {![::tcl::pkgconfig get debug] ? 2000 : 1000}] $cmd] if 1 $c }} $i eval {set result} -- cgit v0.12 From f39babb15ad4c4c1131eb731e61417c7b68ac8cd Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 3 Sep 2019 10:48:52 +0000 Subject: Backout last commit: Looks like it causes test-failures in event.test on Windows. --- generic/tclEvent.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 0fed0a8..4db524c 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -1379,8 +1379,7 @@ VwaitVarProc( int *donePtr = (int *) clientData; *donePtr = 1; - Tcl_UntraceVar2(interp, name1, name2, - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + Tcl_UntraceVar(interp, name1, TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VwaitVarProc, clientData); return NULL; } -- cgit v0.12 From a52cfae90040fcfebac8aef0c52731bd67864165 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 3 Sep 2019 14:01:58 +0000 Subject: Docfix: \0 is special in nroff, so use \e0 instead --- doc/string.n | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/string.n b/doc/string.n index 7e666ea..8d8be3d 100644 --- a/doc/string.n +++ b/doc/string.n @@ -333,21 +333,21 @@ specified using the forms described in \fBSTRING INDICES\fR. Returns a value equal to \fIstring\fR except that any leading or trailing characters present in the string given by \fIchars\fR are removed. If \fIchars\fR is not specified then white space is removed (any character -for which \fBstring is space\fR returns 1, and "\0"). +for which \fBstring is space\fR returns 1, and "\e0"). .TP \fBstring trimleft \fIstring\fR ?\fIchars\fR? . Returns a value equal to \fIstring\fR except that any leading characters present in the string given by \fIchars\fR are removed. If \fIchars\fR is not specified then white space is removed (any character -for which \fBstring is space\fR returns 1, and "\0"). +for which \fBstring is space\fR returns 1, and "\e0"). .TP \fBstring trimright \fIstring\fR ?\fIchars\fR? . Returns a value equal to \fIstring\fR except that any trailing characters present in the string given by \fIchars\fR are removed. If \fIchars\fR is not specified then white space is removed (any character -for which \fBstring is space\fR returns 1, and "\0"). +for which \fBstring is space\fR returns 1, and "\e0"). .SS "OBSOLETE SUBCOMMANDS" .PP These subcommands are currently supported, but are likely to go away in a -- cgit v0.12 From 33082103364e48e4837709e07c6af56f6b7d49ee Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 3 Sep 2019 19:32:55 +0000 Subject: Expand acronym in comment. --- generic/tclCompile.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 1a7d32f..680ab66 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -2127,8 +2127,8 @@ TclCompileScript( Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv"); } /* - * Check depth to avoid SO by too many nested calls of TclCompileScript - * (considering interp recursionlimit). + * Check depth to avoid overflow of the C execution stack by too many + * nested calls of TclCompileScript (considering interp recursionlimit). * Factor 5/4 (1.25) is used to avoid too mistaken limit recognition * during "mixed" evaluation and compilation process (nested eval+compile) * and is good enough for default recursionlimit (1000). -- cgit v0.12 From e583aab8c93cf6a1c2bd747295996e83667b6bf8 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 4 Sep 2019 10:50:49 +0000 Subject: When using Tcl 8.7 headers, don't worry about threaded-allocator mismatch any more in rules.vc. --- win/rules.vc | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/win/rules.vc b/win/rules.vc index b1a0346..4662b00 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -1293,9 +1293,9 @@ OPTDEFINES = $(OPTDEFINES) -DTCL_MEM_DEBUG !if $(TCL_COMPILE_DEBUG) OPTDEFINES = $(OPTDEFINES) -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS !endif -!if $(TCL_THREADS) && $(TCL_VERSION) <= 86 +!if $(TCL_THREADS) && $(TCL_VERSION) < 87 OPTDEFINES = $(OPTDEFINES) -DTCL_THREADS=1 -!if $(USE_THREAD_ALLOC) +!if $(USE_THREAD_ALLOC) && $(TCL_VERSION) < 87 OPTDEFINES = $(OPTDEFINES) -DUSE_THREAD_ALLOC=1 !endif !endif @@ -1775,7 +1775,7 @@ TCLNMAKECONFIG = "$(OUT_DIR)\tcl.nmake" !if defined(CORE_MACHINE) && "$(CORE_MACHINE)" != "$(MACHINE)" !error ERROR: Build target ($(MACHINE)) does not match the Tcl library architecture ($(CORE_MACHINE)). !endif -!if defined(CORE_USE_THREAD_ALLOC) && $(CORE_USE_THREAD_ALLOC) != $(USE_THREAD_ALLOC) +!if $(TCL_VERSION) < 87 && defined(CORE_USE_THREAD_ALLOC) && $(CORE_USE_THREAD_ALLOC) != $(USE_THREAD_ALLOC) !message WARNING: Value of USE_THREAD_ALLOC ($(USE_THREAD_ALLOC)) does not match its Tcl core value ($(CORE_USE_THREAD_ALLOC)). !endif !if defined(CORE_DEBUG) && $(CORE_DEBUG) != $(DEBUG) -- cgit v0.12 From f39b7c73e64487788f86dfb9ae11585767f284fc Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 4 Sep 2019 15:53:19 +0000 Subject: Don't build on travis with GCC on Windows, since it currently doesn't work in combination with autoconf-2.59-generated configure --- .travis.yml | 31 ++----------------------------- 1 file changed, 2 insertions(+), 29 deletions(-) diff --git a/.travis.yml b/.travis.yml index 0504a45..294390a 100644 --- a/.travis.yml +++ b/.travis.yml @@ -17,7 +17,7 @@ matrix: env: - CFGOPT=--disable-shared - BUILD_DIR=unix -# Debug build. Running test-cases disabled, because it is currently failing. +# Debug builds. Running test-cases disabled, because it is currently failing. - name: "Linux/GCC/Debug/no test" os: linux dist: xenial @@ -154,7 +154,7 @@ matrix: - wine env: - BUILD_DIR=win - - CFGOPT=--host=i686-w64-mingw32 + - CFGOPT="--host=i686-w64-mingw32" script: &crosstest - make all tcltest # Include a high visibility marker that tests are skipped outright @@ -246,33 +246,6 @@ matrix: script: - cmd.exe /C 'vcvarsall.bat x64 && nmake OPTS=symbols,msvcrt,threads -f makefile.vc all tcltest' - cmd.exe /C 'vcvarsall.bat x64 && nmake OPTS=symbols,msvcrt,threads -f makefile.vc test' - - name: "Windows/GCC/Shared" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - - CFGOPT="--enable-64bit" - before_install: - - choco install make - - cd ${BUILD_DIR} - - name: "Windows/GCC/Static" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - - CFGOPT="--enable-64bit --disable-shared" - before_install: - - choco install make - - cd ${BUILD_DIR} - - name: "Windows/GCC/Debug" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - - CFGOPT="--enable-64bit --enable-symbols" - before_install: - - choco install make - - cd ${BUILD_DIR} before_install: - cd ${BUILD_DIR} install: -- cgit v0.12 From 7c8cdba292435979d0f9c588b6da62c0a994414a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 5 Sep 2019 06:56:49 +0000 Subject: Fix [4718b41c56]: windows x86 & x64: file mtime overflows in modification date (2038?, windows 32-bit time_t?) --- win/tclWinPort.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/tclWinPort.h b/win/tclWinPort.h index a88c6c8..fa699f0 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -19,7 +19,7 @@ #define __MINGW_USE_VC2005_COMPAT #endif -#if !defined(_WIN64) && !defined(__MINGW_USE_VC2005_COMPAT) && defined(BUILD_tcl) +#if !defined(_WIN64) && !defined(__MINGW_USE_VC2005_COMPAT) /* See [Bug 3354324]: file mtime sets wrong time */ # define _USE_32BIT_TIME_T #endif -- cgit v0.12 From 3de08d01700c288fa184c887feb45b3de5f3e515 Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 5 Sep 2019 16:09:22 +0000 Subject: amend to [4718b41c56]: check size of st_mtime instead of time_t in constraint --- tests/cmdAH.test | 2 +- win/tclWinTest.c | 7 ++++++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/tests/cmdAH.test b/tests/cmdAH.test index e4205f1..c8318c0 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -20,7 +20,7 @@ testConstraint testsetplatform [llength [info commands testsetplatform]] testConstraint testvolumetype [llength [info commands testvolumetype]] testConstraint time64bit [expr { $::tcl_platform(pointerSize) >= 8 || - [llength [info command testsize]] && [testsize time_t] >= 8 + [llength [info command testsize]] && [testsize st_mtime] >= 8 }] testConstraint linkDirectory [expr { ![testConstraint win] || diff --git a/win/tclWinTest.c b/win/tclWinTest.c index dd5a60e..04878fe 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -326,9 +326,14 @@ TestSizeCmd( 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"); + Tcl_WrongNumArgs(interp, 1, objv, "time_t|st_mtime"); return TCL_ERROR; } -- cgit v0.12 From 3179298819aa21980bfe9e77759c6e5f7291e77a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 6 Sep 2019 08:58:19 +0000 Subject: Don't let Tcl depend on USE_32BIT_TIME_T any more: If your compiler supports it, time_t will be 64-bit internally. But at API-level, time_t will still be restricted to 32-bit on Win32 (Not on Win64). This keeps Tcl_StatBuf the same (unless USE_64BIT_TIME_T is defined), so 64-bit times still cannot be used everywhere. --- generic/tcl.h | 2 +- generic/tclBasic.c | 14 ++++---------- win/tclWinPort.h | 6 +----- win/tclWinTime.c | 25 +++++++++++++++++++------ 4 files changed, 25 insertions(+), 22 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index bc4d9a6..bab5dd4 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -414,7 +414,7 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; #if defined(__WIN32__) # ifdef __BORLANDC__ typedef struct stati64 Tcl_StatBuf; -# elif defined(_WIN64) || defined(__MINGW_USE_VC2005_COMPAT) || defined(_USE_64BIT_TIME_T) +# elif defined(_WIN64) || defined(_USE_64BIT_TIME_T) typedef struct __stat64 Tcl_StatBuf; # elif (defined(_MSC_VER) && (_MSC_VER < 1400)) || defined(_USE_32BIT_TIME_T) typedef struct _stati64 Tcl_StatBuf; diff --git a/generic/tclBasic.c b/generic/tclBasic.c index f59c161..52e0ce5 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -413,19 +413,13 @@ Tcl_CreateInterp(void) Tcl_Panic("Tcl_CallFrame must not be smaller than CallFrame"); } -#if defined(_WIN32) && !defined(_WIN64) && !defined(_USE_64BIT_TIME_T) \ - && !defined(__MINGW_USE_VC2005_COMPAT) - /* If Tcl is compiled on Win32 using -D_USE_64BIT_TIME_T or - * -D__MINGW_USE_VC2005_COMPAT, the result is a binary incompatible - * with the 'standard' build of Tcl: All extensions using Tcl_StatBuf - * or interal functions like TclpGetDate() need to be recompiled in +#if defined(_WIN32) && !defined(_WIN64) && !defined(_USE_64BIT_TIME_T) + /* If Tcl is compiled on Win32 using -D_USE_64BIT_TIME_T + * the result is a binary incompatible with the 'standard' build of + * Tcl: All extensions using Tcl_StatBuf need to be recompiled in * the same way. Therefore, this is not officially supported. * In stead, it is recommended to use Win64 or Tcl 9.0 (not released yet) */ - if (sizeof(time_t) != 4) { - /*NOTREACHED*/ - Tcl_Panic(" is not compatible with MSVC"); - } if ((TclOffset(Tcl_StatBuf,st_atime) != 32) || (TclOffset(Tcl_StatBuf,st_ctime) != 40)) { /*NOTREACHED*/ diff --git a/win/tclWinPort.h b/win/tclWinPort.h index b14aa6b..c30d346 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -14,13 +14,9 @@ #ifndef _TCLWINPORT #define _TCLWINPORT -/* define _USE_64BIT_TIME_T (or make/configure option time64bit) to force 64-bit time_t */ -#if defined(_USE_64BIT_TIME_T) -#define __MINGW_USE_VC2005_COMPAT -#endif #if !defined(_WIN64) && !defined(__MINGW_USE_VC2005_COMPAT) /* See [Bug 3354324]: file mtime sets wrong time */ -# define _USE_32BIT_TIME_T +# define __MINGW_USE_VC2005_COMPAT #endif #define WIN32_LEAN_AND_MEAN diff --git a/win/tclWinTime.c b/win/tclWinTime.c index c3c22a4..1204ec7 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -845,6 +845,11 @@ TclpGetDate( { struct tm *tmPtr; time_t time; +#if defined(_WIN64) || (defined(_USE_64BIT_TIME_T) || (defined(_MSC_VER) && _MSC_VER < 1400)) +# define t2 *t /* no need to cripple time to 32-bit */ +#else + time_t t2 = *(__time32_t *)t; +#endif if (!useGMT) { #if defined(_MSC_VER) && (_MSC_VER >= 1900) @@ -877,15 +882,15 @@ TclpGetDate( #define LOCALTIME_VALIDITY_BOUNDARY 0 #endif - if (*t >= LOCALTIME_VALIDITY_BOUNDARY) { - return TclpLocaltime(t); + if (t2 >= LOCALTIME_VALIDITY_BOUNDARY) { + return TclpLocaltime(&t2); } #if defined(_MSC_VER) && (_MSC_VER >= 1900) _get_timezone(&timezone); #endif - time = *t - timezone; + time = t2 - timezone; /* * If we aren't near to overflowing the long, just add the bias and @@ -893,10 +898,10 @@ TclpGetDate( * result at the end. */ - if (*t < (LONG_MAX - 2*SECSPERDAY) && *t > (LONG_MIN + 2*SECSPERDAY)) { + if (t2 < (LONG_MAX - 2*SECSPERDAY) && t2 > (LONG_MIN + 2*SECSPERDAY)) { tmPtr = ComputeGMT(&time); } else { - tmPtr = ComputeGMT(t); + tmPtr = ComputeGMT(&t2); tzset(); @@ -932,7 +937,7 @@ TclpGetDate( tmPtr->tm_wday = (tmPtr->tm_wday + (int)time) % 7; } } else { - tmPtr = ComputeGMT(t); + tmPtr = ComputeGMT(&t2); } return tmPtr; } @@ -1466,7 +1471,11 @@ TclpGmtime( * Posix gmtime_r function. */ +#if defined(_WIN64) || defined(_USE_64BIT_TIME_T) || (defined(_MSC_VER) && _MSC_VER < 1400) return gmtime(timePtr); +#else + return _gmtime32((CONST __time32_t *)timePtr); +#endif } /* @@ -1498,7 +1507,11 @@ TclpLocaltime( * provide a Posix localtime_r function. */ +#if defined(_WIN64) || defined(_USE_64BIT_TIME_T) || (defined(_MSC_VER) && _MSC_VER < 1400) return localtime(timePtr); +#else + return _localtime32((CONST __time32_t *)timePtr); +#endif } /* -- cgit v0.12 From dae5efd07d01ade231948d43f09364e4b8b580b5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 6 Sep 2019 11:16:43 +0000 Subject: Fix [579a05fb34] (partly): b) tcltest file has mismatched version number. --- unix/Makefile.in | 4 ++-- win/Makefile.in | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index 25f034e..2d94bf9 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -856,8 +856,8 @@ install-libraries: libraries done; @echo "Installing package msgcat 1.6.1 as a Tcl Module"; @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.6.1.tm; - @echo "Installing package tcltest 2.5.0 as a Tcl Module"; - @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.5.0.tm; + @echo "Installing package tcltest 2.5.1 as a Tcl Module"; + @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.5.1.tm; @echo "Installing package platform 1.0.14 as a Tcl Module"; @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.14.tm; diff --git a/win/Makefile.in b/win/Makefile.in index 14e12b9..fa68124 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -713,8 +713,8 @@ install-libraries: libraries install-tzdata install-msgs done; @echo "Installing package msgcat 1.6.1 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.6.1.tm; - @echo "Installing package tcltest 2.5.0 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.5.0.tm; + @echo "Installing package tcltest 2.5.1 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.5.1.tm; @echo "Installing package platform 1.0.14 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.14.tm; @echo "Installing package platform::shell 1.1.4 as a Tcl Module"; -- cgit v0.12 From 779aba1c853be107103b3d87ac6db4bf9bd9c6e6 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 6 Sep 2019 12:28:15 +0000 Subject: Simplify searching for tcl86.lib (and related files): First search for the one without 't' suffix, then the 't' variant. (Without 't' = built with 'configure'/'make', with 't' = built with 'nmake') --- win/rules.vc | 24 +++++++++--------------- 1 file changed, 9 insertions(+), 15 deletions(-) diff --git a/win/rules.vc b/win/rules.vc index 4662b00..68e3b08 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -1085,7 +1085,7 @@ STUBPREFIX = $(PROJECT)stub # Set up paths to various Tcl executables and libraries needed by extensions !if $(DOING_TCL) -TCLSHNAME = $(PROJECT)sh$(TCL_VERSION)$(SUFX).exe +TCLSHNAME = $(PROJECT)sh$(VERSION)$(SUFX).exe TCLSH = $(OUT_DIR)\$(TCLSHNAME) TCLIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib TCLLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT) @@ -1102,20 +1102,17 @@ TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" # When building extensions, we need to locate tclsh. Depending on version # of Tcl we are building against, this may or may not have a "t" suffix. # Try various possibilities in turn. -TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX).exe -!if !exist("$(TCLSH)") && $(TCL_THREADS) -TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX).exe -!endif +TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX:t=).exe !if !exist("$(TCLSH)") -TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX:t=).exe +TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX:t=).exe !endif TCLSTUBLIB = $(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib -TCLIMPLIB = $(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib +TCLIMPLIB = $(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX:t=).lib # When building extensions, may be linking against Tcl that does not add # "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility. !if !exist("$(TCLIMPLIB)") -TCLIMPLIB = $(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX:t=).lib +TCLIMPLIB = $(_TCLDIR)\lib\tcl$(TCL_VERSION)t$(SUFX:t=).lib !endif TCL_LIBRARY = $(_TCLDIR)\lib TCLREGLIB = $(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib @@ -1125,19 +1122,16 @@ TCL_INCLUDES = -I"$(_TCLDIR)\include" !else # Building against Tcl sources -TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX).exe -!if !exist($(TCLSH)) && $(TCL_THREADS) -TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX).exe -!endif -!if !exist($(TCLSH)) TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX:t=).exe +!if !exist($(TCLSH)) +TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX:t=).exe !endif TCLSTUBLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib -TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib +TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX:t=).lib # When building extensions, may be linking against Tcl that does not add # "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility. !if !exist("$(TCLIMPLIB)") -TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX:t=).lib +TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)t$(SUFX:t=).lib !endif TCL_LIBRARY = $(_TCLDIR)\library TCLREGLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib -- cgit v0.12 From 10147df9b8eff9d63134fb4186c1a2fbb8aba7c7 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 6 Sep 2019 14:51:21 +0000 Subject: Fix build with "cl" using configure/make build system. It turns out that using -DIOAPI_NO_64 is harmful on Windows (although it works with mingw-w64) --- win/Makefile.in | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/win/Makefile.in b/win/Makefile.in index 9aa5458..630136c 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -713,7 +713,7 @@ deflate.$(HOST_OBJEXT): $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/deflate.c ioapi.$(HOST_OBJEXT): - $(HOST_CC) -o $@ -DIOAPI_NO_64 -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/ioapi.c + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/ioapi.c iowin32.$(HOST_OBJEXT): $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/iowin32.c @@ -743,7 +743,7 @@ zutil.$(HOST_OBJEXT): $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/zutil.c minizip.$(HOST_OBJEXT): - $(HOST_CC) -o $@ -I$(ZLIB_DIR) -DIOAPI_NO_64 -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/minizip.c + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/minizip.c minizip${HOST_EXEEXT}: $(MINIZIP_OBJS) $(HOST_CC) -o $@ $(MINIZIP_OBJS) -- cgit v0.12 From 2441daf9cda1891fce419e31caac43f44d62eeba Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 6 Sep 2019 15:32:19 +0000 Subject: Fix configure script (re-generated with a modified autoconf-2.59, in which the AC_PROG_MAKE_SET macro is replaced with the one from autoconf-2.69) :-) Re-enable native travis build on Windows, showing that the build now works. --- .travis.yml | 86 ++++++++++++++++++++++++++++++++++++++++------------------- win/configure | 22 ++++++++------- 2 files changed, 70 insertions(+), 38 deletions(-) diff --git a/.travis.yml b/.travis.yml index adf73ef..c68a350 100644 --- a/.travis.yml +++ b/.travis.yml @@ -4,19 +4,6 @@ language: c matrix: include: # Testing on Linux with various compilers - - name: "Linux/Clang/Shared" - os: linux - dist: xenial - compiler: clang - env: - - BUILD_DIR=unix - - name: "Linux/Clang/Static" - os: linux - dist: xenial - compiler: clang - env: - - CFGOPT=--disable-shared - - BUILD_DIR=unix - name: "Linux/GCC/Shared" os: linux dist: xenial @@ -30,16 +17,7 @@ matrix: env: - CFGOPT=--disable-shared - BUILD_DIR=unix -# Debug builds. Running test-cases disabled, because it is currently failing. - - name: "Linux/Clang/Debug/no test" - os: linux - dist: xenial - compiler: clang - env: - - BUILD_DIR=unix - - CFGOPT=--enable-symbols=all - script: - - make all tcltest +# Debug build. Running test-cases disabled, because it is currently failing. - name: "Linux/GCC/Debug/no test" os: linux dist: xenial @@ -98,13 +76,37 @@ matrix: - g++-4.9 env: - BUILD_DIR=unix +# Clang + - name: "Linux/Clang/Shared" + os: linux + dist: xenial + compiler: clang + env: + - BUILD_DIR=unix + - name: "Linux/Clang/Static" + os: linux + dist: xenial + compiler: clang + env: + - CFGOPT=--disable-shared + - BUILD_DIR=unix +# Debug build. Running test-cases disabled, because it is currently failing. + - name: "Linux/Clang/Debug/no test" + os: linux + dist: xenial + compiler: clang + env: + - BUILD_DIR=unix + - CFGOPT=--enable-symbols=all + script: + - make all tcltest # Testing on Mac, various styles - name: "macOS/Xcode 11/Shared/Unix-like" os: osx osx_image: xcode11 env: - BUILD_DIR=unix - - name: "macOS/Xcode 11/Shared/Mac-like" + - name: "macOS/Xcode 11/Shared" os: osx osx_image: xcode11 env: @@ -114,21 +116,21 @@ matrix: - make all # The styles=develop avoids some weird problems on OSX - make test styles=develop - - name: "macOS/Xcode 10/Shared/Mac-like" + - name: "macOS/Xcode 10/Shared" os: osx osx_image: xcode10.2 env: - BUILD_DIR=macosx install: [] script: *mactest - - name: "macOS/Xcode 9/Shared/Mac-like" + - name: "macOS/Xcode 9/Shared" os: osx osx_image: xcode9 env: - BUILD_DIR=macosx install: [] script: *mactest - - name: "macOS/Xcode 8/Shared/Mac-like" + - name: "macOS/Xcode 8/Shared" os: osx osx_image: xcode8 env: @@ -244,10 +246,38 @@ matrix: script: - cmd.exe /C 'vcvarsall.bat x64 && nmake OPTS=symbols,msvcrt,threads -f makefile.vc all tcltest' - cmd.exe /C 'vcvarsall.bat x64 && nmake OPTS=symbols,msvcrt,threads -f makefile.vc test' +# Test on Windows with GCC native + - name: "Windows/GCC/Shared" + os: windows + compiler: gcc + env: + - BUILD_DIR=win + - CFGOPT="--enable-64bit" + before_install: + - choco install make + - cd ${BUILD_DIR} + - name: "Windows/GCC/Static" + os: windows + compiler: gcc + env: + - BUILD_DIR=win + - CFGOPT="--enable-64bit --disable-shared" + before_install: + - choco install make + - cd ${BUILD_DIR} + - name: "Windows/GCC/Debug" + os: windows + compiler: gcc + env: + - BUILD_DIR=win + - CFGOPT="--enable-64bit --enable-symbols" + before_install: + - choco install make + - cd ${BUILD_DIR} before_install: - cd ${BUILD_DIR} install: - - ./configure ${CFGOPT} --prefix=$HOME + - ./configure ${CFGOPT} --prefix=$HOME || (cat config.log && exit 1) before_script: - export ERROR_ON_FAILURES=1 script: diff --git a/win/configure b/win/configure index b754717..d3708d8 100755 --- a/win/configure +++ b/win/configure @@ -3011,24 +3011,26 @@ fi echo "$as_me:$LINENO: checking whether ${MAKE-make} sets \$(MAKE)" >&5 echo $ECHO_N "checking whether ${MAKE-make} sets \$(MAKE)... $ECHO_C" >&6 -set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y,:./+-,___p_,'` +set x ${MAKE-make} +ac_make=`AS_ECHO("$[2]") | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` if eval "test \"\${ac_cv_prog_make_${ac_make}_set+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.make <<\_ACEOF +SHELL = /bin/sh all: - @echo 'ac_maketemp="$(MAKE)"' + @echo '@@@%%%=$(MAKE)=@@@%%%' _ACEOF -# GNU make sometimes prints "make[1]: Entering...", which would confuse us. -eval `${MAKE-make} -f conftest.make 2>/dev/null | grep temp=` -if test -n "$ac_maketemp"; then - eval ac_cv_prog_make_${ac_make}_set=yes -else - eval ac_cv_prog_make_${ac_make}_set=no -fi +# GNU make sometimes prints "make[1]: Entering ...", which would confuse us. +case `${MAKE-make} -f conftest.make 2>/dev/null` in + *@@@%%%=?*=@@@%%%*) + eval ac_cv_prog_make_${ac_make}_set=yes;; + *) + eval ac_cv_prog_make_${ac_make}_set=no;; +esac rm -f conftest.make fi -if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then +if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 SET_MAKE= -- cgit v0.12 From 5b7c6db87d8609f207993339675d523d4ac59d51 Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 6 Sep 2019 17:23:05 +0000 Subject: cherry-pick [b87d2183ca]: test cases covering bug [775ee88560]: segfault in upvar at wrong level, wrong message of uplevel --- tests/uplevel.test | 10 ++++++++++ tests/upvar.test | 11 +++++++++++ 2 files changed, 21 insertions(+) diff --git a/tests/uplevel.test b/tests/uplevel.test index cfe4b72..51ffd34 100644 --- a/tests/uplevel.test +++ b/tests/uplevel.test @@ -83,6 +83,16 @@ test uplevel-3.4 {uplevel to same level} { a1 } 55 +test uplevel-4.0.1 {error: non-existent level} -body { + uplevel #0 { uplevel { set y 222 } } +} -returnCodes error -result {bad level "1"} +test uplevel-4.0.2 {error: non-existent level} -setup { + interp create i +} -body { + i eval { uplevel { set y 222 } } +} -returnCodes error -result {bad level "1"} -cleanup { + interp delete i +} test uplevel-4.1 {error: non-existent level} { list [catch c1 msg] $msg } {1 {bad level "#2"}} diff --git a/tests/upvar.test b/tests/upvar.test index d18fd3b..f41fe1b 100644 --- a/tests/upvar.test +++ b/tests/upvar.test @@ -298,6 +298,17 @@ test upvar-8.3 {errors in upvar command} { proc p1 {} {upvar a b c} list [catch p1 msg] $msg } {1 {wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"}} +test upvar-8.3.1 {bad level for upvar (upvar at top-level, bug [775ee88560])} -body { + proc p1 {} { uplevel { upvar b b; lappend b UNEXPECTED } } + uplevel #0 { p1 } +} -returnCodes error -result {bad level "1"} +test upvar-8.3.2 {bad level for upvar (upvar at top-level, bug [775ee88560])} -setup { + interp create i +} -body { + i eval { upvar b b; lappend b UNEXPECTED } +} -returnCodes error -result {bad level "1"} -cleanup { + interp delete i +} test upvar-8.4 {errors in upvar command} { proc p1 {} {upvar 0 b b} list [catch p1 msg] $msg -- cgit v0.12 From 5ed9c57d7a6452cb9bb3ae0c72953cbbf7b81c24 Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 6 Sep 2019 17:23:58 +0000 Subject: fix bad level (if specified argument is not a level at all) --- generic/tclProc.c | 1 + 1 file changed, 1 insertion(+) diff --git a/generic/tclProc.c b/generic/tclProc.c index d58e8da..f1e0148 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -849,6 +849,7 @@ TclObjGetFrame( level = curLevel - 1; result = 0; + name = "1"; } /* -- cgit v0.12 From bacdfc5ef0bf56c2c3f6d8710b843f9715ac2f26 Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 6 Sep 2019 17:36:06 +0000 Subject: cherry-pick [af744d56e0ffcc65] fixed segfault of [775ee88560] in 8.7 --- generic/tclProc.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclProc.c b/generic/tclProc.c index 8beb701..d83134b 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -834,7 +834,7 @@ TclObjGetFrame( } if (name == NULL) { - name = TclGetString(objPtr); + name = objPtr ? TclGetString(objPtr) : "1" ; } Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", name, NULL); -- cgit v0.12 From d0f808008dd96dd8b4ba1988087dbb644ac63283 Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 6 Sep 2019 20:22:30 +0000 Subject: if frameName (actual level) does not contain a real level (#0 or 1) historically TclGetFrame and Tcl_UpVar2 uses current level - 1, so to put supplied name in case of bad level (error at top - 1) is wrong; be more consistent with TclObjGetFrame (at least in error case if relative level used). --- generic/tclProc.c | 11 ++++++++--- tests/upvar.test | 2 +- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/generic/tclProc.c b/generic/tclProc.c index f1e0148..2ee2456 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -713,17 +713,22 @@ TclGetFrame( result = 1; curLevel = iPtr->varFramePtr->level; if (*name== '#') { - if (Tcl_GetInt(interp, name+1, &level) != TCL_OK || level < 0) { + if (Tcl_GetInt(NULL, name+1, &level) != TCL_OK || level < 0) { goto levelError; } } else if (isdigit(UCHAR(*name))) { /* INTL: digit */ - if (Tcl_GetInt(interp, name, &level) != TCL_OK) { + if (Tcl_GetInt(NULL, name, &level) != TCL_OK) { goto levelError; } level = curLevel - level; } else { + /* + * (historical, TODO) If name does not contain a level (#0 or 1), + * TclGetFrame and Tcl_UpVar2 uses current level - 1 + */ level = curLevel - 1; result = 0; + name = "1"; /* be more consistent with TclObjGetFrame (error at top - 1) */ } /* @@ -812,7 +817,7 @@ TclObjGetFrame( } level = curLevel - level; } else if (*name == '#') { - if (Tcl_GetInt(interp, name+1, &level) != TCL_OK || level < 0) { + if (Tcl_GetInt(NULL, name+1, &level) != TCL_OK || level < 0) { goto levelError; } diff --git a/tests/upvar.test b/tests/upvar.test index f41fe1b..cba2fb9 100644 --- a/tests/upvar.test +++ b/tests/upvar.test @@ -357,7 +357,7 @@ test upvar-8.11 {upvar will not create a variable that looks like an array} -bod test upvar-9.1 {Tcl_UpVar2 procedure} testupvar { list [catch {testupvar xyz a {} x global} msg] $msg -} {1 {bad level "xyz"}} +} {1 {bad level "1"}} test upvar-9.2 {Tcl_UpVar2 procedure} testupvar { catch {unset a} catch {unset x} -- cgit v0.12 From 73dfa2cc44e2ad57cd2dbe38240c1f5135ebbf56 Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 6 Sep 2019 20:37:21 +0000 Subject: simple and binary compatible fix for [775ee88560]: use correct relative level (1) in case of top-1, "bad level" message points "below global level" (no regressions anymore, all tests pass) --- generic/tclProc.c | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/generic/tclProc.c b/generic/tclProc.c index d83134b..85d6531 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -808,7 +808,7 @@ TclObjGetFrame( } else { result = -1; } - } else if (TclGetWideBitsFromObj(interp, objPtr, &w) == TCL_OK) { + } else if (TclGetWideBitsFromObj(NULL, objPtr, &w) == TCL_OK) { /* * If this were an integer, we'd have succeeded already. * Docs say we have to treat this as a 'bad level' error. @@ -817,10 +817,16 @@ TclObjGetFrame( } } - if (result == 0) { - level = curLevel - 1; - } if (result != -1) { + /* if relative current level */ + if (result == 0) { + if (!curLevel) { + /* we are in top-level, so simply generate bad level */ + name = "1"; + goto badLevel; + } + level = curLevel - 1; + } if (level >= 0) { CallFrame *framePtr; for (framePtr = iPtr->varFramePtr; framePtr != NULL; @@ -832,7 +838,7 @@ TclObjGetFrame( } } } - +badLevel: if (name == NULL) { name = objPtr ? TclGetString(objPtr) : "1" ; } -- cgit v0.12 From 5ea46c24a2d2e32cd25e06728a7b81f3a949f5a8 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 7 Sep 2019 08:53:43 +0000 Subject: Fix bug 9d10c37aa8 (in the Tk repository): Improperly converted link in HTML man page for ttk::style --- tools/tcltk-man2html-utils.tcl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tools/tcltk-man2html-utils.tcl b/tools/tcltk-man2html-utils.tcl index 250feeb..65d81de 100644 --- a/tools/tcltk-man2html-utils.tcl +++ b/tools/tcltk-man2html-utils.tcl @@ -869,7 +869,7 @@ proc insert-cross-references {text} { [expr {$offset(end-bold)-1}]] set text [string range $text[set text ""] \ [expr {$offset(end-bold)+4}] end] - regsub {http://[\w/.]+} $body {&} body + regsub {http://[\w/.-]+} $body {&} body append result [cross-reference $body] continue } @@ -905,7 +905,7 @@ proc insert-cross-references {text} { url { set off [lindex $offsets 0] append result [string range $text 0 [expr {$off-1}]] - regexp -indices -start $off {http://[\w/.]+} $text range + regexp -indices -start $off {http://[\w/.-]+} $text range set url [string range $text {*}$range] append result "$url" set text [string range $text[set text ""] \ -- cgit v0.12 From c4a716a51763edcf3c68dd8caf5359f20d430779 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 7 Sep 2019 14:36:11 +0000 Subject: Add --enable-threads to Windows/GCC (native) builds. This is - most likely - the cause of the travis failure in compile.test. --- .travis.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.travis.yml b/.travis.yml index c68a350..fd6f31a 100644 --- a/.travis.yml +++ b/.travis.yml @@ -252,7 +252,7 @@ matrix: compiler: gcc env: - BUILD_DIR=win - - CFGOPT="--enable-64bit" + - CFGOPT="--enable-64bit --enable-threads" before_install: - choco install make - cd ${BUILD_DIR} @@ -261,7 +261,7 @@ matrix: compiler: gcc env: - BUILD_DIR=win - - CFGOPT="--enable-64bit --disable-shared" + - CFGOPT="--enable-64bit --enable-threads --disable-shared" before_install: - choco install make - cd ${BUILD_DIR} @@ -270,7 +270,7 @@ matrix: compiler: gcc env: - BUILD_DIR=win - - CFGOPT="--enable-64bit --enable-symbols" + - CFGOPT="--enable-64bit --enable-threads --enable-symbols" before_install: - choco install make - cd ${BUILD_DIR} -- cgit v0.12 From e092b29faa1269648eb8fcddc2527428c2e4876b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 8 Sep 2019 13:26:00 +0000 Subject: dde and registry extension should be compiled with -DUNICODE -D_UNICODE. Put 64-bit builds before 32-bit builds in travis --- .travis.yml | 72 ++++++++++++++++++++++++++++----------------------------- win/Makefile.in | 10 +++++++- 2 files changed, 45 insertions(+), 37 deletions(-) diff --git a/.travis.yml b/.travis.yml index fd6f31a..e1b8bd0 100644 --- a/.travis.yml +++ b/.travis.yml @@ -137,6 +137,42 @@ matrix: - BUILD_DIR=macosx install: [] script: *mactest +# Test with mingw-w64 cross-compile +# Doesn't run tests because wine is only an imperfect Windows emulation + - name: "Linux-cross-Windows/GCC/Shared/no test" + os: linux + dist: xenial + compiler: x86_64-w64-mingw32-gcc + addons: &mingw64 + apt: + packages: + - gcc-mingw-w64-base + - binutils-mingw-w64-x86-64 + - gcc-mingw-w64-x86-64 + - gcc-mingw-w64 + - wine + env: + - BUILD_DIR=win + - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit --enable-threads" + script: *crosstest + - name: "Linux-cross-Windows/GCC/Static/no test" + os: linux + dist: xenial + compiler: x86_64-w64-mingw32-gcc + addons: *mingw64 + env: + - BUILD_DIR=win + - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit --enable-threads --disable-shared" + script: *crosstest + - name: "Linux-cross-Windows/GCC/Debug/no test" + os: linux + dist: xenial + compiler: x86_64-w64-mingw32-gcc + addons: *mingw64 + env: + - BUILD_DIR=win + - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit --enable-threads --enable-symbols" + script: *crosstest # Test with mingw-w64 (32 bit) cross-compile # Doesn't run tests because wine is only an imperfect Windows emulation - name: "Linux-cross-Windows-32/GCC/Shared/no test" @@ -178,42 +214,6 @@ matrix: - BUILD_DIR=win - CFGOPT="--host=i686-w64-mingw32 --enable-threads --enable-symbols" script: *crosstest -# Test with mingw-w64 (64 bit) -# Doesn't run tests because wine is only an imperfect Windows emulation - - name: "Linux-cross-Windows-64/GCC/Shared/no test" - os: linux - dist: xenial - compiler: x86_64-w64-mingw32-gcc - addons: &mingw64 - apt: - packages: - - gcc-mingw-w64-base - - binutils-mingw-w64-x86-64 - - gcc-mingw-w64-x86-64 - - gcc-mingw-w64 - - wine - env: - - BUILD_DIR=win - - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit --enable-threads" - script: *crosstest - - name: "Linux-cross-Windows-64/GCC/Static/no test" - os: linux - dist: xenial - compiler: x86_64-w64-mingw32-gcc - addons: *mingw64 - env: - - BUILD_DIR=win - - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit --enable-threads --disable-shared" - script: *crosstest - - name: "Linux-cross-Windows-64/GCC/Debug/no test" - os: linux - dist: xenial - compiler: x86_64-w64-mingw32-gcc - addons: *mingw64 - env: - - BUILD_DIR=win - - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit --enable-threads --enable-symbols" - script: *crosstest # Test on Windows with MSVC native - name: "Windows/MSVC/Shared" os: windows diff --git a/win/Makefile.in b/win/Makefile.in index 6f2044f5..49ee104 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -498,7 +498,15 @@ tclWinInit.${OBJEXT}: tclWinInit.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) tclWinPipe.${OBJEXT}: tclWinPipe.c - $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_PIPE_DLL=\"$(PIPE_DLL_FILE)\" \ + $(CC) -c $(CC_SWITCHES) -D_BUILD_tcl -DTCL_PIPE_DLL=\"$(PIPE_DLL_FILE)\" \ + $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) + +tclWinReg.${OBJEXT}: tclWinReg.c + $(CC) -c $(CC_SWITCHES) -DUNICODE -D_UNICODE + $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) + +tclWinDde.${OBJEXT}: tclWinDde.c + $(CC) -c $(CC_SWITCHES) -DUNICODE -D_UNICODE $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) testMain.${OBJEXT}: tclAppInit.c -- cgit v0.12 From fcfecf0c0d902bcabce45b30db42a5d387ae774a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 9 Sep 2019 08:41:14 +0000 Subject: Final touch to make everything work for 8.5: - Don't use AS_ECHO macro, because autoconf-2.59 doesn't have it. - -D_BUILD_tcl should be -DBUILD_tcl - Missing back-slashes at the end of the line. --- win/Makefile.in | 6 +++--- win/configure | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/win/Makefile.in b/win/Makefile.in index 49ee104..8561bc2 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -498,15 +498,15 @@ tclWinInit.${OBJEXT}: tclWinInit.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) tclWinPipe.${OBJEXT}: tclWinPipe.c - $(CC) -c $(CC_SWITCHES) -D_BUILD_tcl -DTCL_PIPE_DLL=\"$(PIPE_DLL_FILE)\" \ + $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_PIPE_DLL=\"$(PIPE_DLL_FILE)\" \ $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) tclWinReg.${OBJEXT}: tclWinReg.c - $(CC) -c $(CC_SWITCHES) -DUNICODE -D_UNICODE + $(CC) -c $(CC_SWITCHES) -DUNICODE -D_UNICODE \ $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) tclWinDde.${OBJEXT}: tclWinDde.c - $(CC) -c $(CC_SWITCHES) -DUNICODE -D_UNICODE + $(CC) -c $(CC_SWITCHES) -DUNICODE -D_UNICODE \ $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) testMain.${OBJEXT}: tclAppInit.c diff --git a/win/configure b/win/configure index d3708d8..7da12da 100755 --- a/win/configure +++ b/win/configure @@ -3012,7 +3012,7 @@ fi echo "$as_me:$LINENO: checking whether ${MAKE-make} sets \$(MAKE)" >&5 echo $ECHO_N "checking whether ${MAKE-make} sets \$(MAKE)... $ECHO_C" >&6 set x ${MAKE-make} -ac_make=`AS_ECHO("$[2]") | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` +ac_make=`echo "" | sed 'y,:./+-,___p_,'` if eval "test \"\${ac_cv_prog_make_${ac_make}_set+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else -- cgit v0.12 From 7f3d79834326c84f710028a5d603ee1a9896d8c7 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 9 Sep 2019 09:00:44 +0000 Subject: Move &crosstest up in .travis.yml --- .travis.yml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/.travis.yml b/.travis.yml index e1b8bd0..2a04faf 100644 --- a/.travis.yml +++ b/.travis.yml @@ -154,7 +154,11 @@ matrix: env: - BUILD_DIR=win - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit --enable-threads" - script: *crosstest + script: &crosstest + - make all tcltest + # Include a high visibility marker that tests are skipped outright + - > + echo "`tput setaf 3`SKIPPED TEST: CROSS COMPILING`tput sgr0`" - name: "Linux-cross-Windows/GCC/Static/no test" os: linux dist: xenial @@ -191,11 +195,7 @@ matrix: env: - BUILD_DIR=win - CFGOPT="--host=i686-w64-mingw32 --enable-threads" - script: &crosstest - - make all tcltest - # Include a high visibility marker that tests are skipped outright - - > - echo "`tput setaf 3`SKIPPED TEST: CROSS COMPILING`tput sgr0`" + script: *crosstest - name: "Linux-cross-Windows-32/GCC/Static/no test" os: linux dist: xenial -- cgit v0.12 From 6a8c97bdf8f14ed848fdb877b3dad50ae36983d8 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 9 Sep 2019 09:23:47 +0000 Subject: Don't use -64 in travis titles any more: x64 is implicit if 32-bit is not explicitely mentioned. --- .travis.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.travis.yml b/.travis.yml index 403055e..bb68054 100644 --- a/.travis.yml +++ b/.travis.yml @@ -189,7 +189,7 @@ matrix: - BUILD_DIR=win - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit --disable-shared" script: *crosstest - - name: "Linux-cross-Windows-64/GCC/Shared/no test: UTF_MAX=6" + - name: "Linux-cross-Windows/GCC/Shared/no test: UTF_MAX=6" os: linux dist: xenial compiler: x86_64-w64-mingw32-gcc @@ -207,7 +207,7 @@ matrix: - BUILD_DIR=win - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit CFLAGS=-DTCL_UTF_MAX=3" script: *crosstest - - name: "Linux-cross-Windows-64/GCC/Shared/no test: NO_DEPRECATED" + - name: "Linux-cross-Windows/GCC/Shared/no test: NO_DEPRECATED" os: linux dist: xenial compiler: x86_64-w64-mingw32-gcc @@ -216,7 +216,7 @@ matrix: - BUILD_DIR=win - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit CFLAGS=-DTCL_NO_DEPRECATED=1" script: *crosstest - - name: "Linux-cross-Windows-64/GCC/Debug/no test" + - name: "Linux-cross-Windows/GCC/Debug/no test" os: linux dist: xenial compiler: x86_64-w64-mingw32-gcc -- cgit v0.12 From c939eccf4a344a7389c1e21adec2a22df721e6a2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 10 Sep 2019 08:02:55 +0000 Subject: Add 32-bit (Windows-x86) builds to travis, both with MSVC and GCC --- .travis.yml | 60 +++++++++++++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 53 insertions(+), 7 deletions(-) diff --git a/.travis.yml b/.travis.yml index 2a04faf..a360c2a 100644 --- a/.travis.yml +++ b/.travis.yml @@ -246,6 +246,34 @@ matrix: script: - cmd.exe /C 'vcvarsall.bat x64 && nmake OPTS=symbols,msvcrt,threads -f makefile.vc all tcltest' - cmd.exe /C 'vcvarsall.bat x64 && nmake OPTS=symbols,msvcrt,threads -f makefile.vc test' +# Test on Windows with MSVC native (32-bit) + - name: "Windows/MSVC-x86/Shared" + os: windows + compiler: cl + env: *vcenv + before_install: *vcpreinst + install: [] + script: + - cmd.exe /C 'vcvarsall.bat x86 && nmake OPTS=threads -f makefile.vc all tcltest' + - cmd.exe /C 'vcvarsall.bat x86 && nmake OPTS=threads -f makefile.vc test' + - name: "Windows/MSVC-x86/Static" + os: windows + compiler: cl + env: *vcenv + before_install: *vcpreinst + install: [] + script: + - cmd.exe /C 'vcvarsall.bat x86 && nmake OPTS=static,msvcrt,threads -f makefile.vc all tcltest' + - cmd.exe /C 'vcvarsall.bat x86 && nmake OPTS=static,msvcrt,threads -f makefile.vc test' + - name: "Windows/MSVC-x86/Debug" + os: windows + compiler: cl + env: *vcenv + before_install: *vcpreinst + install: [] + script: + - cmd.exe /C 'vcvarsall.bat x86 && nmake OPTS=symbols,msvcrt,threads -f makefile.vc all tcltest' + - cmd.exe /C 'vcvarsall.bat x86 && nmake OPTS=symbols,msvcrt,threads -f makefile.vc test' # Test on Windows with GCC native - name: "Windows/GCC/Shared" os: windows @@ -253,7 +281,7 @@ matrix: env: - BUILD_DIR=win - CFGOPT="--enable-64bit --enable-threads" - before_install: + before_install: &makepreinst - choco install make - cd ${BUILD_DIR} - name: "Windows/GCC/Static" @@ -262,18 +290,36 @@ matrix: env: - BUILD_DIR=win - CFGOPT="--enable-64bit --enable-threads --disable-shared" - before_install: - - choco install make - - cd ${BUILD_DIR} + before_install: *makepreinst - name: "Windows/GCC/Debug" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="--enable-64bit --enable-threads --enable-symbols" - before_install: - - choco install make - - cd ${BUILD_DIR} + before_install: *makepreinst +# Test on Windows with GCC native (32-bit) + - name: "Windows/GCC-x86/Shared" + os: windows + compiler: gcc + env: + - BUILD_DIR=win + - CFGOPT="--enable-threads" + before_install: *makepreinst + - name: "Windows/GCC-x86/Static" + os: windows + compiler: gcc + env: + - BUILD_DIR=win + - CFGOPT="--enable-threads --disable-shared" + before_install: *makepreinst + - name: "Windows/GCC-x86/Debug" + os: windows + compiler: gcc + env: + - BUILD_DIR=win + - CFGOPT="--enable-threads --enable-symbols" + before_install: *makepreinst before_install: - cd ${BUILD_DIR} install: -- cgit v0.12 From 3d2df2eae1e70c6f665c91b11d5caedc357f9cc1 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 10 Sep 2019 11:59:29 +0000 Subject: Run all test-cases with -verbose sbtel, so we can see which test-case actually hangs. --- .travis.yml | 35 +++++++++++++++-------------------- 1 file changed, 15 insertions(+), 20 deletions(-) diff --git a/.travis.yml b/.travis.yml index a360c2a..a52005f 100644 --- a/.travis.yml +++ b/.travis.yml @@ -15,18 +15,15 @@ matrix: dist: xenial compiler: gcc env: - - CFGOPT=--disable-shared + - CFGOPT="--disable-shared" - BUILD_DIR=unix -# Debug build. Running test-cases disabled, because it is currently failing. - - name: "Linux/GCC/Debug/no test" + - name: "Linux/GCC/Debug" os: linux dist: xenial compiler: gcc env: - BUILD_DIR=unix - - CFGOPT=--enable-symbols=all - script: - - make all tcltest + - CFGOPT="--enable-symbols" # Older versions of GCC... - name: "Linux/GCC 7/Shared" os: linux @@ -88,24 +85,22 @@ matrix: dist: xenial compiler: clang env: - - CFGOPT=--disable-shared + - CFGOPT="--disable-shared" - BUILD_DIR=unix -# Debug build. Running test-cases disabled, because it is currently failing. - - name: "Linux/Clang/Debug/no test" + - name: "Linux/Clang/Debug" os: linux dist: xenial compiler: clang env: - BUILD_DIR=unix - - CFGOPT=--enable-symbols=all - script: - - make all tcltest + - CFGOPT="--enable-symbols" # Testing on Mac, various styles - name: "macOS/Xcode 11/Shared/Unix-like" os: osx osx_image: xcode11 env: - BUILD_DIR=unix + - CFGOPT="--enable-threads" - name: "macOS/Xcode 11/Shared" os: osx osx_image: xcode11 @@ -115,7 +110,7 @@ matrix: script: &mactest - make all # The styles=develop avoids some weird problems on OSX - - make test styles=develop + - make test styles=develop TESTFLAGS="-verbose sbtel" - name: "macOS/Xcode 10/Shared" os: osx osx_image: xcode10.2 @@ -227,7 +222,7 @@ matrix: install: [] script: - cmd.exe /C 'vcvarsall.bat x64 && nmake OPTS=threads -f makefile.vc all tcltest' - - cmd.exe /C 'vcvarsall.bat x64 && nmake OPTS=threads -f makefile.vc test' + - cmd.exe /C 'vcvarsall.bat x64 && nmake OPTS=threads -f makefile.vc test TESTFLAGS="-verbose sbtel"' - name: "Windows/MSVC/Static" os: windows compiler: cl @@ -236,7 +231,7 @@ matrix: install: [] script: - cmd.exe /C 'vcvarsall.bat x64 && nmake OPTS=static,msvcrt,threads -f makefile.vc all tcltest' - - cmd.exe /C 'vcvarsall.bat x64 && nmake OPTS=static,msvcrt,threads -f makefile.vc test' + - cmd.exe /C 'vcvarsall.bat x64 && nmake OPTS=static,msvcrt,threads -f makefile.vc test TESTFLAGS="-verbose sbtel"' - name: "Windows/MSVC/Debug" os: windows compiler: cl @@ -245,7 +240,7 @@ matrix: install: [] script: - cmd.exe /C 'vcvarsall.bat x64 && nmake OPTS=symbols,msvcrt,threads -f makefile.vc all tcltest' - - cmd.exe /C 'vcvarsall.bat x64 && nmake OPTS=symbols,msvcrt,threads -f makefile.vc test' + - cmd.exe /C 'vcvarsall.bat x64 && nmake OPTS=symbols,msvcrt,threads -f makefile.vc test TESTFLAGS="-verbose sbtel"' # Test on Windows with MSVC native (32-bit) - name: "Windows/MSVC-x86/Shared" os: windows @@ -255,7 +250,7 @@ matrix: install: [] script: - cmd.exe /C 'vcvarsall.bat x86 && nmake OPTS=threads -f makefile.vc all tcltest' - - cmd.exe /C 'vcvarsall.bat x86 && nmake OPTS=threads -f makefile.vc test' + - cmd.exe /C 'vcvarsall.bat x86 && nmake OPTS=threads -f makefile.vc test TESTFLAGS="-verbose sbtel"' - name: "Windows/MSVC-x86/Static" os: windows compiler: cl @@ -264,7 +259,7 @@ matrix: install: [] script: - cmd.exe /C 'vcvarsall.bat x86 && nmake OPTS=static,msvcrt,threads -f makefile.vc all tcltest' - - cmd.exe /C 'vcvarsall.bat x86 && nmake OPTS=static,msvcrt,threads -f makefile.vc test' + - cmd.exe /C 'vcvarsall.bat x86 && nmake OPTS=static,msvcrt,threads -f makefile.vc test TESTFLAGS="-verbose sbtel"' - name: "Windows/MSVC-x86/Debug" os: windows compiler: cl @@ -273,7 +268,7 @@ matrix: install: [] script: - cmd.exe /C 'vcvarsall.bat x86 && nmake OPTS=symbols,msvcrt,threads -f makefile.vc all tcltest' - - cmd.exe /C 'vcvarsall.bat x86 && nmake OPTS=symbols,msvcrt,threads -f makefile.vc test' + - cmd.exe /C 'vcvarsall.bat x86 && nmake OPTS=symbols,msvcrt,threads -f makefile.vc test TESTFLAGS="-verbose sbtel"' # Test on Windows with GCC native - name: "Windows/GCC/Shared" os: windows @@ -328,4 +323,4 @@ before_script: - export ERROR_ON_FAILURES=1 script: - make all tcltest - - make test + - make test TESTFLAGS="-verbose sbtel" -- cgit v0.12 From 4dc0eb331451143f9fac2621140d60c8073eb21d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 10 Sep 2019 12:03:40 +0000 Subject: Backport some improvements to tm.tcl (mostly comments). Don't use ::tcl_platform(debug) anymore, since it cannot be thrusted: Better use [::tcl::pkgconfig get debug] Reduce limits in tests/compile.test (13.2), since apparently it's still too much for some platforms. --- library/dde/pkgIndex.tcl | 4 +- library/reg/pkgIndex.tcl | 4 +- library/tm.tcl | 226 ++++++++++++++++++++++------------------------- tests/compile.test | 4 +- 4 files changed, 112 insertions(+), 126 deletions(-) diff --git a/library/dde/pkgIndex.tcl b/library/dde/pkgIndex.tcl index 065dc83..bcb5f9c 100644 --- a/library/dde/pkgIndex.tcl +++ b/library/dde/pkgIndex.tcl @@ -1,6 +1,6 @@ -if {![package vsatisfies [package provide Tcl] 8]} return +if {![package vsatisfies [package provide Tcl] 8.5]} return if {[info sharedlibextension] != ".dll"} return -if {[info exists ::tcl_platform(debug)]} { +if {[::tcl::pkgconfig get debug]} { package ifneeded dde 1.4.1 [list load [file join $dir tcldde14g.dll] dde] } else { package ifneeded dde 1.4.1 [list load [file join $dir tcldde14.dll] dde] diff --git a/library/reg/pkgIndex.tcl b/library/reg/pkgIndex.tcl index 12c7ea5..9a85944 100755 --- a/library/reg/pkgIndex.tcl +++ b/library/reg/pkgIndex.tcl @@ -1,6 +1,6 @@ -if {![package vsatisfies [package provide Tcl] 8]} return +if {![package vsatisfies [package provide Tcl] 8.5]} return if {[info sharedlibextension] != ".dll"} return -if {[info exists ::tcl_platform(debug)]} { +if {[::tcl::pkgconfig get debug]} { package ifneeded registry 1.3.3 \ [list load [file join $dir tclreg13g.dll] registry] } else { diff --git a/library/tm.tcl b/library/tm.tcl index 87db0df..40b8e40 100644 --- a/library/tm.tcl +++ b/library/tm.tcl @@ -1,48 +1,44 @@ # -*- tcl -*- # -# Searching for Tcl Modules. Defines a procedure, declares it as the -# primary command for finding packages, however also uses the former -# 'package unknown' command as a fallback. +# Searching for Tcl Modules. Defines a procedure, declares it as the primary +# command for finding packages, however also uses the former 'package unknown' +# command as a fallback. # -# Locates all possible packages in a directory via a less restricted -# glob. The targeted directory is derived from the name of the -# requested package. I.e. the TM scan will look only at directories -# which can contain the requested package. It will register all -# packages it found in the directory so that future requests have a -# higher chance of being fulfilled by the ifneeded database without -# having to come to us again. +# Locates all possible packages in a directory via a less restricted glob. The +# targeted directory is derived from the name of the requested package, i.e. +# the TM scan will look only at directories which can contain the requested +# package. It will register all packages it found in the directory so that +# future requests have a higher chance of being fulfilled by the ifneeded +# database without having to come to us again. # -# We do not remember where we have been and simply rescan targeted -# directories when invoked again. The reasoning is this: +# We do not remember where we have been and simply rescan targeted directories +# when invoked again. The reasoning is this: # -# - The only way we get back to the same directory is if someone is -# trying to [package require] something that wasn't there on the -# first scan. +# - The only way we get back to the same directory is if someone is trying to +# [package require] something that wasn't there on the first scan. # # Either # 1) It is there now: If we rescan, you get it; if not you don't. # -# This covers the possibility that the application asked for a -# package late, and the package was actually added to the -# installation after the application was started. It shoukld -# still be able to find it. +# This covers the possibility that the application asked for a package +# late, and the package was actually added to the installation after the +# application was started. It shoukld still be able to find it. # -# 2) It still is not there: Either way, you don't get it, but the -# rescan takes time. This is however an error case and we dont't -# care that much about it +# 2) It still is not there: Either way, you don't get it, but the rescan +# takes time. This is however an error case and we dont't care that much +# about it # -# 3) It was there the first time; but for some reason a "package -# forget" has been run, and "package" doesn't know about it -# anymore. +# 3) It was there the first time; but for some reason a "package forget" has +# been run, and "package" doesn't know about it anymore. # -# This can be an indication that the application wishes to reload -# some functionality. And should work as well. +# This can be an indication that the application wishes to reload some +# functionality. And should work as well. # -# Note that this also strikes a balance between doing a glob targeting -# a single package, and thus most likely requiring multiple globs of -# the same directory when the application is asking for many packages, -# and trying to glob for _everything_ in all subdirectories when -# looking for a package, which comes with a heavy startup cost. +# Note that this also strikes a balance between doing a glob targeting a +# single package, and thus most likely requiring multiple globs of the same +# directory when the application is asking for many packages, and trying to +# glob for _everything_ in all subdirectories when looking for a package, +# which comes with a heavy startup cost. # # We scan for regular packages only if no satisfying module was found. @@ -71,46 +67,43 @@ namespace eval ::tcl::tm { # path with 'list'. # # Results -# No result for subcommands 'add' and 'remove'. A list of paths -# for 'list'. +# No result for subcommands 'add' and 'remove'. A list of paths for +# 'list'. # # Sideeffects -# The subcommands 'add' and 'remove' manipulate the list of -# paths to search for Tcl Modules. The subcommand 'list' has no -# sideeffects. +# The subcommands 'add' and 'remove' manipulate the list of paths to +# search for Tcl Modules. The subcommand 'list' has no sideeffects. -proc ::tcl::tm::add {path args} { +proc ::tcl::tm::add {args} { # PART OF THE ::tcl::tm::path ENSEMBLE # # The path is added at the head to the list of module paths. # - # The command enforces the restriction that no path may be an - # ancestor directory of any other path on the list. If the new - # path violates this restriction an error wil be raised. + # The command enforces the restriction that no path may be an ancestor + # directory of any other path on the list. If the new path violates this + # restriction an error wil be raised. # - # If the path is already present as is no error will be raised and - # no action will be taken. + # If the path is already present as is no error will be raised and no + # action will be taken. variable paths - # We use a copy of the path as source during validation, and - # extend it as well. Because we not only have to detect if the new - # paths are bogus with respect to the existing paths, but also - # between themselves. Otherwise we can still add bogus paths, by - # specifying them in a single call. This makes the use of the new - # paths simpler as well, a trivial assignment of the collected - # paths to the official state var. + # We use a copy of the path as source during validation, and extend it as + # well. Because we not only have to detect if the new paths are bogus with + # respect to the existing paths, but also between themselves. Otherwise we + # can still add bogus paths, by specifying them in a single call. This + # makes the use of the new paths simpler as well, a trivial assignment of + # the collected paths to the official state var. set newpaths $paths - foreach p [linsert $args 0 $path] { + foreach p $args { if {$p in $newpaths} { # Ignore a path already on the list. continue } - # Search for paths which are subdirectories of the new one. If - # there are any then the new path violates the restriction - # about ancestors. + # Search for paths which are subdirectories of the new one. If there + # are any then the new path violates the restriction about ancestors. set pos [lsearch -glob $newpaths ${p}/*] # Cannot use "in", we need the position for the message. @@ -119,10 +112,9 @@ proc ::tcl::tm::add {path args} { "$p is ancestor of existing module path [lindex $newpaths $pos]." } - # Now look for existing paths which are ancestors of the new - # one. This reverse question forces us to loop over the - # existing paths, as each element is the pattern, not the new - # path :( + # Now look for existing paths which are ancestors of the new one. This + # reverse question forces us to loop over the existing paths, as each + # element is the pattern, not the new path :( foreach ep $newpaths { if {[string match ${ep}/* $p]} { @@ -134,24 +126,23 @@ proc ::tcl::tm::add {path args} { set newpaths [linsert $newpaths 0 $p] } - # The validation of the input is complete and successful, and - # everything in newpaths is either an old path, or added. We can - # now extend the official list of paths, a simple assignment is - # sufficient. + # The validation of the input is complete and successful, and everything + # in newpaths is either an old path, or added. We can now extend the + # official list of paths, a simple assignment is sufficient. set paths $newpaths return } -proc ::tcl::tm::remove {path args} { +proc ::tcl::tm::remove {args} { # PART OF THE ::tcl::tm::path ENSEMBLE # - # Removes the path from the list of module paths. The command is - # silently ignored if the path is not on the list. + # Removes the path from the list of module paths. The command is silently + # ignored if the path is not on the list. variable paths - foreach p [linsert $args 0 $path] { + foreach p $args { set pos [lsearch -exact $paths $p] if {$pos >= 0} { set paths [lreplace $paths $pos $pos] @@ -177,17 +168,16 @@ proc ::tcl::tm::list {} { # empty string. # exact - Either -exact or ommitted. # -# Name, version, and exact are used to determine -# satisfaction. The original is called iff no satisfaction was -# achieved. The name is also used to compute the directory to -# target in the search. +# Name, version, and exact are used to determine satisfaction. The +# original is called iff no satisfaction was achieved. The name is also +# used to compute the directory to target in the search. # # Results # None. # # Sideeffects -# May populate the package ifneeded database with additional -# provide scripts. +# May populate the package ifneeded database with additional provide +# scripts. proc ::tcl::tm::UnknownHandler {original name args} { # Import the list of paths to search for packages in module form. @@ -196,8 +186,8 @@ proc ::tcl::tm::UnknownHandler {original name args} { variable paths variable pkgpattern - # Without paths to search we can do nothing. (Except falling back - # to the regular search). + # Without paths to search we can do nothing. (Except falling back to the + # regular search). if {[llength $paths]} { set pkgpath [string map {:: /} $name] @@ -206,11 +196,10 @@ proc ::tcl::tm::UnknownHandler {original name args} { set pkgroot "" } - # We don't remember a copy of the paths while looping. Tcl - # Modules are unable to change the list while we are searching - # for them. This also simplifies the loop, as we cannot get - # additional directories while iterating over the list. A - # simple foreach is sufficient. + # We don't remember a copy of the paths while looping. Tcl Modules are + # unable to change the list while we are searching for them. This also + # simplifies the loop, as we cannot get additional directories while + # iterating over the list. A simple foreach is sufficient. set satisfied 0 foreach path $paths { @@ -223,12 +212,11 @@ proc ::tcl::tm::UnknownHandler {original name args} { } set strip [llength [file split $path]] - # We can't use glob in safe interps, so enclose the following - # in a catch statement, where we get the module files out - # of the subdirectories. In other words, Tcl Modules are - # not-functional in such an interpreter. This is the same - # as for the command "tclPkgUnknown", i.e. the search for - # regular packages. + # We can't use glob in safe interps, so enclose the following in a + # catch statement, where we get the module files out of the + # subdirectories. In other words, Tcl Modules are not-functional + # in such an interpreter. This is the same as for the command + # "tclPkgUnknown", i.e. the search for regular packages. catch { # We always look for _all_ possible modules in the current @@ -238,13 +226,13 @@ proc ::tcl::tm::UnknownHandler {original name args} { set pkgfilename [join [lrange [file split $file] $strip end] ::] if {![regexp -- $pkgpattern $pkgfilename --> pkgname pkgversion]} { - # Ignore everything not matching our pattern - # for package names. + # Ignore everything not matching our pattern for + # package names. continue } if {[catch {package vcompare $pkgversion 0}]} { - # Ignore everything where the version part is - # not acceptable to "package vcompare". + # Ignore everything where the version part is not + # acceptable to "package vcompare". continue } @@ -257,38 +245,36 @@ proc ::tcl::tm::UnknownHandler {original name args} { continue } - # We have found a candidate, generate a "provide - # script" for it, and remember it. Note that we - # are using ::list to do this; locally [list] - # means something else without the namespace - # specifier. - - # NOTE. When making changes to the format of the - # provide command generated below CHECK that the - # 'LOCATE' procedure in core file - # 'platform/shell.tcl' still understands it, or, - # if not, update its implementation appropriately. + # We have found a candidate, generate a "provide script" + # for it, and remember it. Note that we are using ::list + # to do this; locally [list] means something else without + # the namespace specifier. + + # NOTE. When making changes to the format of the provide + # command generated below CHECK that the 'LOCATE' + # procedure in core file 'platform/shell.tcl' still + # understands it, or, if not, update its implementation + # appropriately. # - # Right now LOCATE's implementation assumes that - # the path of the package file is the last element - # in the list. + # Right now LOCATE's implementation assumes that the path + # of the package file is the last element in the list. package ifneeded $pkgname $pkgversion \ "[::list package provide $pkgname $pkgversion];[::list source -encoding utf-8 $file]" - # We abort in this unknown handler only if we got - # a satisfying candidate for the requested - # package. Otherwise we still have to fallback to - # the regular package search to complete the - # processing. + # We abort in this unknown handler only if we got a + # satisfying candidate for the requested package. + # Otherwise we still have to fallback to the regular + # package search to complete the processing. if {($pkgname eq $name) && [package vsatisfies $pkgversion {*}$args]} { set satisfied 1 - # We do not abort the loop, and keep adding - # provide scripts for every candidate in the - # directory, just remember to not fall back to - # the regular search anymore. + + # We do not abort the loop, and keep adding provide + # scripts for every candidate in the directory, just + # remember to not fall back to the regular search + # anymore. } } } @@ -299,8 +285,8 @@ proc ::tcl::tm::UnknownHandler {original name args} { } } - # Fallback to previous command, if existing. See comment above - # about ::list... + # Fallback to previous command, if existing. See comment above about + # ::list... if {[llength $original]} { uplevel 1 $original [::linsert $args 0 $name] @@ -366,22 +352,22 @@ proc ::tcl::tm::Defaults {} { # Calls 'path add' to paths to the list of module search paths. proc ::tcl::tm::roots {paths} { - lassign [split [package present Tcl] .] major minor + regexp {^(\d+)\.(\d+)} [package present Tcl] - major minor foreach pa $paths { set p [file join $pa tcl$major] for {set n $minor} {$n >= 0} {incr n -1} { set px [file join $p ${major}.${n}] - if {![interp issafe]} { set px [file normalize $px] } + if {![interp issafe]} {set px [file normalize $px]} path add $px } set px [file join $p site-tcl] - if {![interp issafe]} { set px [file normalize $px] } + if {![interp issafe]} {set px [file normalize $px]} path add $px } return } -# Initialization. Set up the default paths, then insert the new -# handler into the chain. +# Initialization. Set up the default paths, then insert the new handler into +# the chain. -if {![interp issafe]} { ::tcl::tm::Defaults } +if {![interp issafe]} {::tcl::tm::Defaults} diff --git a/tests/compile.test b/tests/compile.test index cd26fdf..a66da22 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -442,10 +442,10 @@ test compile-13.2 {TclCompileScript: testing nested scripts compilation} -setup }} } -body { # Test different compilation variants (instructions evalStk, invokeStk, etc), - # with 2000 (1000 in debug) nested scripts (bodies). If you get SO/SF exceptions on some low-stack + # with 1500 (750 in debug) nested scripts (bodies). If you get SO/SF exceptions on some low-stack # boxes or systems, please don't decrease it (either provide a constraint) $i eval {foreach cmd {eval "if 1" catch} { - set c [gencode [expr {![::tcl::pkgconfig get debug] ? 2000 : 1000}] $cmd] + set c [gencode [expr {![::tcl::pkgconfig get debug] ? 1500 : 750}] $cmd] if 1 $c }} $i eval {set result} -- cgit v0.12 From 4d51f6b054999c72115751f3895158195e42b40d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 10 Sep 2019 12:05:54 +0000 Subject: Don't use constraints like unixOrPc anymore, use unixOrWin (for example) --- tests/chanio.test | 4 +- tests/cmdAH.test | 6 +-- tests/cmdMZ.test | 4 +- tests/fCmd.test | 17 +++++++-- tests/fileName.test | 46 +++++++++++----------- tests/interp.test | 64 +++++++++++++++---------------- tests/io.test | 4 +- tests/ioCmd.test | 10 ++--- tests/pid.test | 2 +- tests/registry.test | 8 ++-- tests/socket.test | 2 +- tests/tcltest.test | 108 ++++++++++++++++++++++++++-------------------------- 12 files changed, 142 insertions(+), 133 deletions(-) diff --git a/tests/chanio.test b/tests/chanio.test index 5d47e0b..a18bbbe 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -2069,7 +2069,7 @@ test chan-io-27.4 {FlushChannel, implicit flush when buffer fills} { set l } {0 60 72} test chan-io-27.5 {FlushChannel, implicit flush when buffer fills and on chan close} \ - {unixOrPc} { + {unixOrWin} { file delete $path(test1) set f [open $path(test1) w] chan configure $f -translation lf -buffersize 60 -eofchar {} @@ -7339,7 +7339,7 @@ test chan-io-57.2 {buffered data and file events, read} {fileevent} { set result } {1 readable 234567890 timer} -test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrPc openpipe fileevent} { +test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin openpipe fileevent} { set out [open $path(script) w] chan puts $out { chan puts "normal message from pipe" diff --git a/tests/cmdAH.test b/tests/cmdAH.test index c8318c0..03ec3df 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -372,7 +372,7 @@ test cmdAH-8.45 {Tcl_FileObjCmd: dirname} { -match regexp -setup { set temp $::env(HOME) - } + } -body { set ::env(HOME) "/homewontexist/test" testsetplatform windows @@ -878,7 +878,7 @@ test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unix testchmod} { } 1 test cmdAH-18.5 {Tcl_FileObjCmd: executable} {win} { - # On pc, must be a .exe, .com, etc. + # On windows, must be a .exe, .com, etc. set x [file exe $gorpfile] set gorpexe [makeFile foo gorp.exe] @@ -887,7 +887,7 @@ test cmdAH-18.5 {Tcl_FileObjCmd: executable} {win} { set x } {0 1} test cmdAH-18.5.1 {Tcl_FileObjCmd: executable} {win} { - # On pc, must be a .exe, .com, etc. + # On windows, must be a .exe, .com, etc. set x [file exe $gorpfile] set gorpexe [makeFile foo gorp.exe] diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test index 98cb0fb..5f94777 100644 --- a/tests/cmdMZ.test +++ b/tests/cmdMZ.test @@ -224,12 +224,12 @@ foreach script { # More tests of Tcl_SourceObjCmd are in source.test test cmdMZ-3.3 {Tcl_SourceObjCmd: error conditions} -constraints { - unixOrPc + unixOrWin } -body { list [catch {source} msg] $msg } -match glob -result {1 {wrong # args: should be "source*fileName"}} test cmdMZ-3.4 {Tcl_SourceObjCmd: error conditions} -constraints { - unixOrPc + unixOrWin } -body { list [catch {source a b} msg] $msg } -match glob -result {1 {wrong # args: should be "source*fileName"}} diff --git a/tests/fCmd.test b/tests/fCmd.test index f53128d..71bc186 100644 --- a/tests/fCmd.test +++ b/tests/fCmd.test @@ -26,6 +26,15 @@ testConstraint winOlderThan2000 0 testConstraint notNetworkFilesystem 0 testConstraint 95or98 [expr {[testConstraint 95] || [testConstraint 98]}] testConstraint 2000orNewer [expr {![testConstraint 95or98]}] +testConstraint reg 0 +if {[testConstraint win]} { + if {![catch { + ::tcltest::loadTestedCommands + set ::regver [package require registry 1.3.3] + }]} { + testConstraint reg 1 + } +} set tmpspace /tmp;# default value # Find a group that exists on this Unix system, or else skip tests that @@ -49,7 +58,7 @@ if {[testConstraint unix]} { } # Also used in winFCmd... -if {[testConstraint winOnly]} { +if {[testConstraint win]} { if {[testConstraint nt] && $::tcl_platform(osVersion) >= 5.0} { if {$::tcl_platform(osVersion) >= 6.0} { testConstraint winVista 1 @@ -259,7 +268,7 @@ test fCmd-3.14 {FileCopyRename: FileBasename fails} -setup { } -result {user "_totally_bogus_user" doesn't exist} test fCmd-3.15 {FileCopyRename: source[0] == '\0'} -setup { cleanup -} -constraints {notRoot unixOrPc} -returnCodes error -body { +} -constraints {notRoot unixOrWin} -returnCodes error -body { file mkdir td1 file rename / td1 } -result {error renaming "/" to "td1": file already exists} @@ -387,7 +396,7 @@ test fCmd-5.4 {TclFileDeleteCmd: multiple files} {notRoot} { file delete tf1 td1 tf2 lappend x [file exists tf1] [file exists tf2] [file exists tf3] } {1 1 1 0 0 0} -test fCmd-5.5 {TclFileDeleteCmd: stop at first error} {notRoot unixOrPc} { +test fCmd-5.5 {TclFileDeleteCmd: stop at first error} {notRoot unixOrWin} { cleanup createfile tf1 createfile tf2 @@ -1080,7 +1089,7 @@ test fCmd-10.5 {file copy: comprehensive: dir to empty dir} -setup { } -result [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4 tds1 tds2 tds3 tds4} {1 {error copying "td1" to "[file join td2 td1]": file already exists}} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} 1 1 1}] test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} -setup { cleanup -} -constraints {notRoot unixOrPc testchmod} -body { +} -constraints {notRoot unixOrWin testchmod} -body { file mkdir tds1 file mkdir tds2 file mkdir [file join tdd1 tds1 xxx] diff --git a/tests/fileName.test b/tests/fileName.test index a4c8efe..3747fc9 100644 --- a/tests/fileName.test +++ b/tests/fileName.test @@ -1116,13 +1116,13 @@ file delete -force $tildeglobname set globname globTest unset horribleglobname tildeglobname -test filename-12.1 {simple globbing} {unixOrPc} { +test filename-12.1 {simple globbing} {unixOrWin} { list [catch {glob {}} msg] $msg } {0 .} -test filename-12.1.1 {simple globbing} {unixOrPc} { +test filename-12.1.1 {simple globbing} {unixOrWin} { list [catch {glob -types f {}} msg] $msg } {1 {no files matched glob pattern ""}} -test filename-12.1.2 {simple globbing} {unixOrPc} { +test filename-12.1.2 {simple globbing} {unixOrWin} { list [catch {glob -types d {}} msg] $msg } {0 .} test filename-12.1.3 {simple globbing} {unix} { @@ -1144,7 +1144,7 @@ test filename-12.3 {simple globbing} { set globPreResult globTest/ set x1 x1.c set y1 y1.c -test filename-12.4 {simple globbing} {unixOrPc} { +test filename-12.4 {simple globbing} {unixOrWin} { lsort [glob globTest/x1.c globTest/y1.c globTest/foo] } "$globPreResult$x1 $globPreResult$y1" test filename-12.5 {simple globbing} { @@ -1231,32 +1231,32 @@ test filename-13.9 {globbing with brace substitution} { test filename-13.10 {globbing with brace substitution} { list [lsort [catch {glob globTest/\{x,,y\}1.c} msg]] $msg } [list 0 [list $globPreResult$x1 $globPreResult$y1]] -test filename-13.11 {globbing with brace substitution} {unixOrPc} { +test filename-13.11 {globbing with brace substitution} {unixOrWin} { list [lsort [catch {glob globTest/\{x,x\\,z,z\}1.c} msg]] $msg } {0 {globTest/x1.c globTest/x,z1.c globTest/z1.c}} test filename-13.13 {globbing with brace substitution} { lsort [glob globTest/{a,b,x,y}1.c] } [list $globPreResult$x1 $globPreResult$y1] -test filename-13.14 {globbing with brace substitution} {unixOrPc} { +test filename-13.14 {globbing with brace substitution} {unixOrWin} { lsort [glob {globTest/{x1,y2,weird name}.c}] } {{globTest/weird name.c} globTest/x1.c} -test filename-13.16 {globbing with brace substitution} {unixOrPc} { +test filename-13.16 {globbing with brace substitution} {unixOrWin} { lsort [glob globTest/{x1.c,a1/*}] } {globTest/a1/b1 globTest/a1/b2 globTest/x1.c} -test filename-13.18 {globbing with brace substitution} {unixOrPc} { +test filename-13.18 {globbing with brace substitution} {unixOrWin} { lsort [glob globTest/{x1.c,{a},a1/*}] } {globTest/a1/b1 globTest/a1/b2 globTest/x1.c} -test filename-13.20 {globbing with brace substitution} {unixOrPc} { +test filename-13.20 {globbing with brace substitution} {unixOrWin} { lsort [glob globTest/{a,x}1/*/{x,y}*] } {globTest/a1/b1/x2.c globTest/a1/b2/y2.c} test filename-13.22 {globbing with brace substitution} { list [catch {glob globTest/\{a,x\}1/*/\{} msg] $msg } {1 {unmatched open-brace in file name}} -test filename-14.1 {asterisks, question marks, and brackets} {unixOrPc} { +test filename-14.1 {asterisks, question marks, and brackets} {unixOrWin} { lsort [glob glo*/*.c] } {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c} -test filename-14.3 {asterisks, question marks, and brackets} {unixOrPc} { +test filename-14.3 {asterisks, question marks, and brackets} {unixOrWin} { lsort [glob globTest/?1.c] } {globTest/x1.c globTest/y1.c globTest/z1.c} @@ -1266,7 +1266,7 @@ file rename globTest [file join globTestContext globTest] set savepwd [pwd] cd globTestContext -test filename-14.5 {asterisks, question marks, and brackets} {unixOrPc} { +test filename-14.5 {asterisks, question marks, and brackets} {unixOrWin} { lsort [glob */*/*/*.c] } {globTest/a1/b1/x2.c globTest/a1/b2/y2.c} @@ -1281,16 +1281,16 @@ test filename-14.7 {asterisks, question marks, and brackets} {unix} { test filename-14.7.1 {asterisks, question marks, and brackets} {win} { lsort [glob globTest/*] } {globTest/.1 globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c} -test filename-14.9 {asterisks, question marks, and brackets} {unixOrPc} { +test filename-14.9 {asterisks, question marks, and brackets} {unixOrWin} { lsort [glob globTest/.*] } {globTest/. globTest/.. globTest/.1} -test filename-14.11 {asterisks, question marks, and brackets} {unixOrPc} { +test filename-14.11 {asterisks, question marks, and brackets} {unixOrWin} { lsort [glob globTest/*/*] } {globTest/a1/b1 globTest/a1/b2 globTest/a2/b3} -test filename-14.13 {asterisks, question marks, and brackets} {unixOrPc} { +test filename-14.13 {asterisks, question marks, and brackets} {unixOrWin} { lsort [glob {globTest/[xyab]1.*}] } {globTest/x1.c globTest/y1.c} -test filename-14.15 {asterisks, question marks, and brackets} {unixOrPc} { +test filename-14.15 {asterisks, question marks, and brackets} {unixOrWin} { lsort [glob globTest/*/] } {globTest/a1/ globTest/a2/ globTest/a3/} test filename-14.17 {asterisks, question marks, and brackets} { @@ -1301,7 +1301,7 @@ test filename-14.17 {asterisks, question marks, and brackets} { set env(HOME) $temp set result } [list 0 [list [file join $env(HOME) globTest z1.c]]] -test filename-14.18 {asterisks, question marks, and brackets} {unixOrPc} { +test filename-14.18 {asterisks, question marks, and brackets} {unixOrWin} { list [catch {lsort [glob globTest/*.c goo/*]} msg] $msg } {0 {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}} test filename-14.20 {asterisks, question marks, and brackets} { @@ -1340,16 +1340,16 @@ test filename-14.25.1 {type specific globbing} {win} { test filename-14.26 {type specific globbing} { list [catch {glob -nocomplain -dir globTest -types {readonly} *} msg] $msg } [list 0 {}] -test filename-14.27 {Bug 2710920} {unixOrPc} { +test filename-14.27 {Bug 2710920} {unixOrWin} { file tail [lindex [lsort [glob globTest/*/]] 0] } a1 -test filename-14.28 {Bug 2710920} {unixOrPc} { +test filename-14.28 {Bug 2710920} {unixOrWin} { file dirname [lindex [lsort [glob globTest/*/]] 0] } globTest -test filename-14.29 {Bug 2710920} {unixOrPc} { +test filename-14.29 {Bug 2710920} {unixOrWin} { file extension [lindex [lsort [glob globTest/*/]] 0] } {} -test filename-14.30 {Bug 2710920} {unixOrPc} { +test filename-14.30 {Bug 2710920} {unixOrWin} { file rootname [lindex [lsort [glob globTest/*/]] 0] } globTest/a1/ @@ -1406,7 +1406,7 @@ test filename-15.4.1 {no complain: errors, sequencing} { } {1 {user "wontexist" doesn't exist} 1 {user "blahxyz" doesn't exist}} test filename-15.4.2 {no complain: errors, sequencing} { # test used to fail because if an error occurs, the interp's result - # is reset... + # is reset... string equal \ [list [catch {glob -nocomplain ~wontexist *} res1] $res1] \ [list [catch {glob -nocomplain * ~wontexist} res2] $res2] @@ -1414,7 +1414,7 @@ test filename-15.4.2 {no complain: errors, sequencing} { test filename-15.5 {unix specific globbing} {unix nonPortable} { glob ~ouster/.csh* } "/home/ouster/.cshrc" -catch {close [open globTest/odd\\\[\]*?\{\}name w]} +catch {close [open globTest/odd\\\[\]*?\{\}name w]} test filename-15.6 {unix specific globbing} {unix} { global env set temp $env(HOME) diff --git a/tests/interp.test b/tests/interp.test index 510ab4a..b5632e1 100644 --- a/tests/interp.test +++ b/tests/interp.test @@ -53,7 +53,7 @@ test interp-1.8 {options for interp command} { } {1 {bad option "-froboz": must be alias, aliases, bgerror, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}} test interp-1.9 {options for interp command} { list [catch {interp -froboz -safe} msg] $msg -} {1 {bad option "-froboz": must be alias, aliases, bgerror, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}} +} {1 {bad option "-froboz": must be alias, aliases, bgerror, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}} test interp-1.10 {options for interp command} { list [catch {interp target} msg] $msg } {1 {wrong # args: should be "interp target path alias"}} @@ -68,7 +68,7 @@ test interp-2.2 {basic interpreter creation} { } 0 test interp-2.3 {basic interpreter creation} { catch {interp create -safe} -} 0 +} 0 test interp-2.4 {basic interpreter creation} { list [catch {interp create a} msg] $msg } {1 {interpreter named "a" already exists, cannot create}} @@ -100,7 +100,7 @@ test interp-2.11 {anonymous interps vs existing procs} { set x [interp create] regexp "interp(\[0-9]+)" $x dummy anothernum expr $anothernum > $thenum -} 1 +} 1 test interp-2.12 {anonymous interps vs existing procs} { set x [interp create -safe] regexp "interp(\[0-9]+)" $x dummy thenum @@ -109,11 +109,11 @@ test interp-2.12 {anonymous interps vs existing procs} { set x [interp create -safe] regexp "interp(\[0-9]+)" $x dummy anothernum expr $anothernum - $thenum -} 1 +} 1 test interp-2.13 {correct default when no $path arg is given} -body { interp create -- } -match regexp -result {interp[0-9]+} - + foreach i [interp slaves] { interp delete $i } @@ -854,12 +854,12 @@ test interp-18.9 {eval in deleted interp, bug 495830} { interp create tst interp alias tst suicide {} interp delete tst list [catch {tst eval {suicide; set a 5}} msg] $msg -} {1 {attempt to call eval in deleted interpreter}} +} {1 {attempt to call eval in deleted interpreter}} test interp-18.10 {eval in deleted interp, bug 495830} { interp create tst interp alias tst suicide {} interp delete tst list [catch {tst eval {set set set; suicide; $set a 5}} msg] $msg -} {1 {attempt to call eval in deleted interpreter}} +} {1 {attempt to call eval in deleted interpreter}} # Test alias deletion @@ -949,7 +949,7 @@ test interp-19.9 {alias deletion, renaming} { set l [interp eval a foo] interp delete a set l -} 1156 +} 1156 test interp-20.1 {interp hide, interp expose and interp invokehidden} { set a [interp create] @@ -1170,7 +1170,7 @@ test interp-20.21 {interp hide vs safety} { catch {interp delete a} interp create a -safe set l "" - lappend l [catch {a hide list} msg] + lappend l [catch {a hide list} msg] lappend l $msg interp delete a set l @@ -1179,7 +1179,7 @@ test interp-20.22 {interp hide vs safety} { catch {interp delete a} interp create a -safe set l "" - lappend l [catch {interp hide a list} msg] + lappend l [catch {interp hide a list} msg] lappend l $msg interp delete a set l @@ -1188,7 +1188,7 @@ test interp-20.23 {interp hide vs safety} { catch {interp delete a} interp create a -safe set l "" - lappend l [catch {a eval {interp hide {} list}} msg] + lappend l [catch {a eval {interp hide {} list}} msg] lappend l $msg interp delete a set l @@ -1198,7 +1198,7 @@ test interp-20.24 {interp hide vs safety} { interp create a -safe interp create {a b} set l "" - lappend l [catch {a eval {interp hide b list}} msg] + lappend l [catch {a eval {interp hide b list}} msg] lappend l $msg interp delete a set l @@ -1217,7 +1217,7 @@ test interp-20.26 {interp expoose vs safety} { catch {interp delete a} interp create a -safe set l "" - lappend l [catch {a hide list} msg] + lappend l [catch {a hide list} msg] lappend l $msg lappend l [catch {a expose list} msg] lappend l $msg @@ -1228,9 +1228,9 @@ test interp-20.27 {interp expose vs safety} { catch {interp delete a} interp create a -safe set l "" - lappend l [catch {interp hide a list} msg] + lappend l [catch {interp hide a list} msg] lappend l $msg - lappend l [catch {interp expose a list} msg] + lappend l [catch {interp expose a list} msg] lappend l $msg interp delete a set l @@ -1239,7 +1239,7 @@ test interp-20.28 {interp expose vs safety} { catch {interp delete a} interp create a -safe set l "" - lappend l [catch {a hide list} msg] + lappend l [catch {a hide list} msg] lappend l $msg lappend l [catch {a eval {interp expose {} list}} msg] lappend l $msg @@ -1250,9 +1250,9 @@ test interp-20.29 {interp expose vs safety} { catch {interp delete a} interp create a -safe set l "" - lappend l [catch {interp hide a list} msg] + lappend l [catch {interp hide a list} msg] lappend l $msg - lappend l [catch {a eval {interp expose {} list}} msg] + lappend l [catch {a eval {interp expose {} list}} msg] lappend l $msg interp delete a set l @@ -1262,9 +1262,9 @@ test interp-20.30 {interp expose vs safety} { interp create a -safe interp create {a b} set l "" - lappend l [catch {interp hide {a b} list} msg] + lappend l [catch {interp hide {a b} list} msg] lappend l $msg - lappend l [catch {a eval {interp expose b list}} msg] + lappend l [catch {a eval {interp expose b list}} msg] lappend l $msg interp delete a set l @@ -1274,7 +1274,7 @@ test interp-20.31 {interp expose vs safety} { interp create a -safe interp create {a b} set l "" - lappend l [catch {interp hide {a b} list} msg] + lappend l [catch {interp hide {a b} list} msg] lappend l $msg lappend l [catch {interp expose {a b} list} msg] lappend l $msg @@ -1631,7 +1631,7 @@ test interp-21.5 {interp hidden} { set l [lsort [interp hidden a]] interp delete a set l -} $hidden_cmds +} $hidden_cmds test interp-21.6 {interp hidden vs interp hide, interp expose} { catch {interp delete a} interp create a @@ -1786,7 +1786,7 @@ test interp-23.1 {testing hiding vs aliases} { interp delete a set l } {{} bar {} bar bar {} {}} -test interp-23.2 {testing hiding vs aliases} {unixOrPc} { +test interp-23.2 {testing hiding vs aliases} {unixOrWin} { catch {interp delete a} interp create a -safe set l "" @@ -1802,7 +1802,7 @@ test interp-23.2 {testing hiding vs aliases} {unixOrPc} { lappend l [lsort [interp hidden a]] interp delete a set l -} {{cd encoding exec exit fconfigure file glob load open pwd socket source unload} {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} {cd encoding exec exit fconfigure file glob load open pwd socket source unload} {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} {bar cd encoding exec exit fconfigure file glob load open pwd socket source unload} {::tcl::mathfunc::max ::tcl::mathfunc::min clock} {cd encoding exec exit fconfigure file glob load open pwd socket source unload}} +} {{cd encoding exec exit fconfigure file glob load open pwd socket source unload} {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} {cd encoding exec exit fconfigure file glob load open pwd socket source unload} {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} {bar cd encoding exec exit fconfigure file glob load open pwd socket source unload} {::tcl::mathfunc::max ::tcl::mathfunc::min clock} {cd encoding exec exit fconfigure file glob load open pwd socket source unload}} test interp-24.1 {result resetting on error} { catch {interp delete a} @@ -2045,7 +2045,7 @@ test interp-26.1 {result code transmission : interp eval direct} { # Test that all the possibles error codes from Tcl get passed up # from the slave interp's context to the master, even though the # slave nominally thinks the command is running at the root level. - + catch {interp delete a} interp create a set res {} @@ -2076,7 +2076,7 @@ test interp-26.3 {result code transmission : aliases} { # Test that all the possibles error codes from Tcl get passed up # from the slave interp's context to the master, even though the # slave nominally thinks the command is running at the root level. - + catch {interp delete a} interp create a set res {} @@ -2193,7 +2193,7 @@ test interp-26.8 {errorInfo transmission: safe interps--bug 1637} {knownBug} { test interp-27.1 {interp aliases & namespaces} { set i [interp create]; set aliasTrace {}; - proc tstAlias {args} { + proc tstAlias {args} { global aliasTrace; lappend aliasTrace [list [namespace current] $args]; } @@ -2206,7 +2206,7 @@ test interp-27.1 {interp aliases & namespaces} { test interp-27.2 {interp aliases & namespaces} { set i [interp create]; set aliasTrace {}; - proc tstAlias {args} { + proc tstAlias {args} { global aliasTrace; lappend aliasTrace [list [namespace current] $args]; } @@ -2219,7 +2219,7 @@ test interp-27.2 {interp aliases & namespaces} { test interp-27.3 {interp aliases & namespaces} { set i [interp create]; set aliasTrace {}; - proc tstAlias {args} { + proc tstAlias {args} { global aliasTrace; lappend aliasTrace [list [namespace current] $args]; } @@ -2234,7 +2234,7 @@ test interp-27.4 {interp aliases & namespaces} { set i [interp create]; namespace eval foo2 { variable aliasTrace {}; - proc bar {args} { + proc bar {args} { variable aliasTrace; lappend aliasTrace [list [namespace current] $args]; } @@ -3206,7 +3206,7 @@ test interp-34.9 {time limits trigger in blocking after} { } msg] set t1 [clock seconds] interp delete $i - list $code $msg [expr {($t1-$t0) < 3 ? "OK" : $t1-$t0}] + list $code $msg [expr {($t1-$t0) < 3 ? "OK" : $t1-$t0}] } {1 {time limit exceeded} OK} test interp-34.10 {time limits trigger in vwaits: Bug 1221395} -body { set i [interp create] @@ -3440,7 +3440,7 @@ test interp-35.24 {interp time limits can't touch current interp} -body { test interp-36.1 {interp bgerror syntax} -body { interp bgerror } -returnCodes error -result {wrong # args: should be "interp bgerror path ?cmdPrefix?"} -test interp-36.2 {interp bgerror syntax} -body { +test interp-36.2 {interp bgerror syntax} -body { interp bgerror x y z } -returnCodes error -result {wrong # args: should be "interp bgerror path ?cmdPrefix?"} test interp-36.3 {interp bgerror syntax} -setup { diff --git a/tests/io.test b/tests/io.test index 13ff38c..4257d51 100644 --- a/tests/io.test +++ b/tests/io.test @@ -2208,7 +2208,7 @@ test io-27.4 {FlushChannel, implicit flush when buffer fills} { set l } {0 60 72} test io-27.5 {FlushChannel, implicit flush when buffer fills and on close} \ - {unixOrPc} { + {unixOrWin} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -buffersize 60 -eofchar {} @@ -8102,7 +8102,7 @@ test io-57.2 {buffered data and file events, read} {fileevent} { set result } {1 readable 234567890 timer} -test io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrPc openpipe fileevent} { +test io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin openpipe fileevent} { set out [open $path(script) w] puts $out { puts "normal message from pipe" diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 460299b..c3893bc 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -265,7 +265,7 @@ removeFile fconfigure.dummy test iocmd-8.14 {fconfigure command} { fconfigure stdin -buffers } 4096 -test iocmd-8.15.1 {fconfigure command / tcp channel} -constraints {socket unixOrPc} -setup { +test iocmd-8.15.1 {fconfigure command / tcp channel} -constraints {socket unixOrWin} -setup { set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0] set port [lindex [fconfigure $srv -sockname] 2] proc iocmdSRV {sock ip port} {close $sock} @@ -367,18 +367,18 @@ test iocmd-10.5 {fblocked command} { set path(test4) [makeFile {} test4] set path(test5) [makeFile {} test5] -test iocmd-11.1 {I/O to command pipelines} {unixOrPc unixExecs} { +test iocmd-11.1 {I/O to command pipelines} {unixOrWin unixExecs} { set f [open $path(test4) w] close $f list [catch {open "| cat < \"$path(test4)\" > \"$path(test5)\"" w} msg] $msg $::errorCode } {1 {can't write input to command: standard input was redirected} NONE} -test iocmd-11.2 {I/O to command pipelines} {unixOrPc unixExecs} { +test iocmd-11.2 {I/O to command pipelines} {unixOrWin unixExecs} { list [catch {open "| echo > \"$path(test5)\"" r} msg] $msg $::errorCode } {1 {can't read output from command: standard output was redirected} NONE} -test iocmd-11.3 {I/O to command pipelines} {unixOrPc unixExecs} { +test iocmd-11.3 {I/O to command pipelines} {unixOrWin unixExecs} { list [catch {open "| echo > \"$path(test5)\"" r+} msg] $msg $::errorCode } {1 {can't read output from command: standard output was redirected} NONE} -test iocmd-11.4 {I/O to command pipelines} unixOrPc { +test iocmd-11.4 {I/O to command pipelines} unixOrWin { list [catch {open "| no_such_command_exists" rb} msg] $msg $::errorCode } {1 {couldn't execute "no_such_command_exists": no such file or directory} {POSIX ENOENT {no such file or directory}}} diff --git a/tests/pid.test b/tests/pid.test index d21dbaa..af21f30 100644 --- a/tests/pid.test +++ b/tests/pid.test @@ -21,7 +21,7 @@ testConstraint pidDefined [llength [info commands pid]] test pid-1.1 {pid command} pidDefined { regexp {(^[0-9]+$)|(^0x[0-9a-fA-F]+$)} [pid] } 1 -test pid-1.2 {pid command} -constraints {unixOrPc unixExecs pidDefined} -setup { +test pid-1.2 {pid command} -constraints {unixOrWin unixExecs pidDefined} -setup { set path(test1) [makeFile {} test1] file delete $path(test1) } -body { diff --git a/tests/registry.test b/tests/registry.test index 539ba2d..9691b3e 100644 --- a/tests/registry.test +++ b/tests/registry.test @@ -242,7 +242,7 @@ test registry-4.2 {GetKeyNames} {win reg} { registry delete HKEY_CURRENT_USER\\TclFoobar set result } {baz} -test registry-4.3 {GetKeyNames: remote key} {win reg nonPortable english} { +test registry-4.3 {GetKeyNames: remote key} {win reg english} { set hostname [info hostname] registry set \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar\\baz set result [registry keys \\\\gaspode\\HKEY_CURRENT_USER\\TclFoobar] @@ -535,7 +535,7 @@ test registry-7.3 {GetValueNames} -constraints {win reg} -setup { } -cleanup { registry delete HKEY_CURRENT_USER\\TclFoobar } -result {{} baz blat} -test registry-7.4 {GetValueNames: remote key} -constraints {win reg nonPortable english} -body { +test registry-7.4 {GetValueNames: remote key} -constraints {win reg english} -body { set hostname [info hostname] registry set \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar baz blat set result [registry values \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar] @@ -571,7 +571,7 @@ test registry-7.7 {GetValueNames: names with spaces} -constraints {win reg} -set registry delete HKEY_CURRENT_USER\\TclFoobar } -result {{baz bar} blat} -test registry-8.1 {OpenSubKey} -constraints {win reg nonPortable english} \ +test registry-8.1 {OpenSubKey} -constraints {win reg english} \ -body { # This test will only succeed if the current user does not have # registry access on the specified machine. @@ -657,7 +657,7 @@ test registry-11.2 {SetValue: modification} -constraints {win reg} \ set result [registry get HKEY_CURRENT_USER\\TclFoobar\\baz blat] } -result {frob} test registry-11.3 {SetValue: failure} \ - -constraints {win reg nonPortable english} \ + -constraints {win reg english} \ -body { # This test will only succeed if the current user does not have # registry access on the specified machine. diff --git a/tests/socket.test b/tests/socket.test index 2fb8988..3544dd9 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -949,7 +949,7 @@ test socket-7.4 {testing socket specific options} {socket} { set l "" lappend l [expr {[lindex $x 2] == $listen}] [llength $x] } {1 3} -test socket-7.5 {testing socket specific options} {socket unixOrPc} { +test socket-7.5 {testing socket specific options} {socket unixOrWin} { set s [socket -server accept 0] proc accept {s a p} { global x diff --git a/tests/tcltest.test b/tests/tcltest.test index ca720ee..c856209 100644 --- a/tests/tcltest.test +++ b/tests/tcltest.test @@ -98,44 +98,44 @@ proc slave {msgVar args} { } return $code } -test tcltest-2.0 {tcltest (verbose default - 'b')} {unixOrPc} { +test tcltest-2.0 {tcltest (verbose default - 'b')} {unixOrWin} { set result [slave msg test.tcl] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 1 0 0 1} -test tcltest-2.1 {tcltest -verbose 'b'} {unixOrPc} { +test tcltest-2.1 {tcltest -verbose 'b'} {unixOrWin} { set result [slave msg test.tcl -verbose 'b'] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 1 0 0 1} -test tcltest-2.2 {tcltest -verbose 'p'} {unixOrPc} { +test tcltest-2.2 {tcltest -verbose 'p'} {unixOrWin} { set result [slave msg test.tcl -verbose 'p'] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 0 1 0 1} -test tcltest-2.3 {tcltest -verbose 's'} {unixOrPc} { +test tcltest-2.3 {tcltest -verbose 's'} {unixOrWin} { set result [slave msg test.tcl -verbose 's'] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 0 0 1 1} -test tcltest-2.4 {tcltest -verbose 'ps'} {unixOrPc} { +test tcltest-2.4 {tcltest -verbose 'ps'} {unixOrWin} { set result [slave msg test.tcl -verbose 'ps'] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 0 1 1 1} -test tcltest-2.5 {tcltest -verbose 'psb'} {unixOrPc} { +test tcltest-2.5 {tcltest -verbose 'psb'} {unixOrWin} { set result [slave msg test.tcl -verbose 'psb'] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 1 1 1 1} -test tcltest-2.5a {tcltest -verbose 'pass skip body'} {unixOrPc} { +test tcltest-2.5a {tcltest -verbose 'pass skip body'} {unixOrWin} { set result [slave msg test.tcl -verbose "pass skip body"] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ @@ -143,7 +143,7 @@ test tcltest-2.5a {tcltest -verbose 'pass skip body'} {unixOrPc} { } {0 1 1 1 1} test tcltest-2.6 {tcltest -verbose 't'} { - -constraints {unixOrPc} + -constraints {unixOrWin} -body { set result [slave msg test.tcl -verbose 't'] list $result $msg @@ -153,7 +153,7 @@ test tcltest-2.6 {tcltest -verbose 't'} { } test tcltest-2.6a {tcltest -verbose 'start'} { - -constraints {unixOrPc} + -constraints {unixOrWin} -body { set result [slave msg test.tcl -verbose start] list $result $msg @@ -176,7 +176,7 @@ test tcltest-2.7 {tcltest::verbose} { } test tcltest-2.8 {tcltest -verbose 'error'} { - -constraints {unixOrPc} + -constraints {unixOrWin} -body { set result [slave msg test.tcl -verbose error] list $result $msg @@ -185,22 +185,22 @@ test tcltest-2.8 {tcltest -verbose 'error'} { -match regexp } # -match, [match] -test tcltest-3.1 {tcltest -match 'a*'} {unixOrPc} { +test tcltest-3.1 {tcltest -match 'a*'} {unixOrWin} { set result [slave msg test.tcl -match a* -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg] } {0 1 0 0 1} -test tcltest-3.2 {tcltest -match 'b*'} {unixOrPc} { +test tcltest-3.2 {tcltest -match 'b*'} {unixOrWin} { set result [slave msg test.tcl -match b* -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+0.+Skipped.+3.+Failed.+1" $msg] } {0 0 1 0 1} -test tcltest-3.3 {tcltest -match 'c*'} {unixOrPc} { +test tcltest-3.3 {tcltest -match 'c*'} {unixOrWin} { set result [slave msg test.tcl -match c* -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+0.+Skipped.+4.+Failed.+0" $msg] } {0 0 0 1 1} -test tcltest-3.4 {tcltest -match 'a* b*'} {unixOrPc} { +test tcltest-3.4 {tcltest -match 'a* b*'} {unixOrWin} { set result [slave msg test.tcl -match {a* b*} -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+2.+Failed.+1" $msg] @@ -220,27 +220,27 @@ test tcltest-3.5 {tcltest::match} { } # -skip, [skip] -test tcltest-4.1 {tcltest -skip 'a*'} {unixOrPc} { +test tcltest-4.1 {tcltest -skip 'a*'} {unixOrWin} { set result [slave msg test.tcl -skip a* -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+0.+Skipped.+2.+Failed.+1" $msg] } {0 0 1 1 1} -test tcltest-4.2 {tcltest -skip 'b*'} {unixOrPc} { +test tcltest-4.2 {tcltest -skip 'b*'} {unixOrWin} { set result [slave msg test.tcl -skip b* -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+2.+Failed.+1" $msg] } {0 1 0 1 1} -test tcltest-4.3 {tcltest -skip 'c*'} {unixOrPc} { +test tcltest-4.3 {tcltest -skip 'c*'} {unixOrWin} { set result [slave msg test.tcl -skip c* -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 1 1 0 1} -test tcltest-4.4 {tcltest -skip 'a* b*'} {unixOrPc} { +test tcltest-4.4 {tcltest -skip 'a* b*'} {unixOrWin} { set result [slave msg test.tcl -skip {a* b*} -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+0.+Skipped.+3.+Failed.+1" $msg] } {0 0 0 1 1} -test tcltest-4.5 {tcltest -match 'a* b*' -skip 'b*'} {unixOrPc} { +test tcltest-4.5 {tcltest -match 'a* b*' -skip 'b*'} {unixOrWin} { set result [slave msg test.tcl -match {a* b*} -skip b* -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg] @@ -261,12 +261,12 @@ test tcltest-4.6 {tcltest::skip} { # -constraints, -limitconstraints, [testConstraint], # $constraintsSpecified, [limitConstraints] -test tcltest-5.1 {tcltest -constraints 'knownBug'} {unixOrPc} { +test tcltest-5.1 {tcltest -constraints 'knownBug'} {unixOrWin} { set result [slave msg test.tcl -constraints knownBug -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+2.+Skipped.+0.+Failed.+2" $msg] } {0 1 1 1 1} -test tcltest-5.2 {tcltest -constraints 'knownBug' -limitconstraints 1} {unixOrPc} { +test tcltest-5.2 {tcltest -constraints 'knownBug' -limitconstraints 1} {unixOrWin} { set result [slave msg test.tcl -constraints knownBug -verbose 'p' -limitconstraints 1] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg] @@ -355,7 +355,7 @@ set printerror [makeFile { } printerror.tcl] test tcltest-6.1 {tcltest -outfile, -errfile defaults} { - -constraints unixOrPc + -constraints unixOrWin -body { slave msg $printerror return $msg @@ -363,21 +363,21 @@ test tcltest-6.1 {tcltest -outfile, -errfile defaults} { -result {a test.*a really} -match regexp } -test tcltest-6.2 {tcltest -outfile a.tmp} {unixOrPc unixExecs} { +test tcltest-6.2 {tcltest -outfile a.tmp} {unixOrWin unixExecs} { slave msg $printerror -outfile a.tmp set result1 [catch {exec grep "a test" a.tmp}] set result2 [catch {exec grep "a really" a.tmp}] list [regexp "a test" $msg] [regexp "a really" $msg] \ $result1 $result2 [file exists a.tmp] [file delete a.tmp] } {0 1 0 1 1 {}} -test tcltest-6.3 {tcltest -errfile a.tmp} {unixOrPc unixExecs} { +test tcltest-6.3 {tcltest -errfile a.tmp} {unixOrWin unixExecs} { slave msg $printerror -errfile a.tmp set result1 [catch {exec grep "a test" a.tmp}] set result2 [catch {exec grep "a really" a.tmp}] list [regexp "a test" $msg] [regexp "a really" $msg] \ $result1 $result2 [file exists a.tmp] [file delete a.tmp] } {1 0 1 0 1 {}} -test tcltest-6.4 {tcltest -outfile a.tmp -errfile b.tmp} {unixOrPc unixExecs} { +test tcltest-6.4 {tcltest -outfile a.tmp -errfile b.tmp} {unixOrWin unixExecs} { slave msg $printerror -outfile a.tmp -errfile b.tmp set result1 [catch {exec grep "a test" a.tmp}] set result2 [catch {exec grep "a really" b.tmp}] @@ -464,25 +464,25 @@ test tcltest-6.8 {tcltest::outputFile (implicit outputFile)} { # Must use child processes to test -debug because it always writes # messages to stdout, and we have no way to capture stdout of a # slave interp -test tcltest-7.1 {tcltest test.tcl -debug 0} {unixOrPc} { +test tcltest-7.1 {tcltest test.tcl -debug 0} {unixOrWin} { catch {exec [interpreter] test.tcl -debug 0} msg regexp "Flags passed into tcltest" $msg } {0} -test tcltest-7.2 {tcltest test.tcl -debug 1} {unixOrPc} { +test tcltest-7.2 {tcltest test.tcl -debug 1} {unixOrWin} { catch {exec [interpreter] test.tcl -debug 1 -skip b*} msg list [regexp userSpecifiedSkip $msg] \ [regexp "Flags passed into tcltest" $msg] } {1 0} -test tcltest-7.3 {tcltest test.tcl -debug 1} {unixOrPc} { +test tcltest-7.3 {tcltest test.tcl -debug 1} {unixOrWin} { catch {exec [interpreter] test.tcl -debug 1 -match b*} msg list [regexp userSpecifiedNonMatch $msg] \ [regexp "Flags passed into tcltest" $msg] } {1 0} -test tcltest-7.4 {tcltest test.tcl -debug 2} {unixOrPc} { +test tcltest-7.4 {tcltest test.tcl -debug 2} {unixOrWin} { catch {exec [interpreter] test.tcl -debug 2} msg list [regexp "Flags passed into tcltest" $msg] [regexp "Running" $msg] } {1 0} -test tcltest-7.5 {tcltest test.tcl -debug 3} {unixOrPc} { +test tcltest-7.5 {tcltest test.tcl -debug 3} {unixOrWin} { catch {exec [interpreter] test.tcl -debug 3} msg list [regexp "Flags passed into tcltest" $msg] [regexp "Running" $msg] } {1 1} @@ -522,7 +522,7 @@ set normaldirectory [makeDirectory normaldirectory] normalizePath normaldirectory # -tmpdir, [temporaryDirectory] -test tcltest-8.1 {tcltest a.tcl -tmpdir a} -constraints unixOrPc -setup { +test tcltest-8.1 {tcltest a.tcl -tmpdir a} -constraints unixOrWin -setup { file delete -force thisdirectorydoesnotexist } -body { slave msg $a -tmpdir thisdirectorydoesnotexist @@ -531,7 +531,7 @@ test tcltest-8.1 {tcltest a.tcl -tmpdir a} -constraints unixOrPc -setup { file delete -force thisdirectorydoesnotexist } -result 1 test tcltest-8.2 {tcltest a.tcl -tmpdir thisdirectoryisafile} { - -constraints unixOrPc + -constraints unixOrWin -body { slave msg $a -tmpdir $tdiaf return $msg @@ -572,7 +572,7 @@ testConstraint notFAT [expr { }] # FAT/NTFS permissions are fairly hopeless; ignore this test if that FS is used test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} { - -constraints {unixOrPc notRoot notFAT} + -constraints {unixOrWin notRoot notFAT} -body { slave msg $a -tmpdir $notWriteableDir return $msg @@ -581,7 +581,7 @@ test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} { -match glob } test tcltest-8.5 {tcltest a.tcl -tmpdir normaldirectory} { - -constraints unixOrPc + -constraints unixOrWin -body { slave msg $a -tmpdir $normaldirectory # The join is necessary because the message can be split on multiple @@ -624,7 +624,7 @@ test tcltest-8.6a {temporaryDirectory - test format 2} -setup { cd [temporaryDirectory] # -testdir, [testsDirectory] test tcltest-8.10 {tcltest a.tcl -testdir thisdirectorydoesnotexist} { - -constraints unixOrPc + -constraints unixOrWin -setup { file delete -force thisdirectorydoesnotexist } @@ -636,7 +636,7 @@ test tcltest-8.10 {tcltest a.tcl -testdir thisdirectorydoesnotexist} { -result {*does not exist*} } test tcltest-8.11 {tcltest a.tcl -testdir thisdirectoryisafile} { - -constraints unixOrPc + -constraints unixOrWin -body { slave msg $a -testdir $tdiaf return $msg @@ -654,7 +654,7 @@ test tcltest-8.12 {tcltest a.tcl -testdir notReadableDir} { -result {*not readable*} } test tcltest-8.13 {tcltest a.tcl -testdir normaldirectory} { - -constraints unixOrPc + -constraints unixOrWin -body { slave msg $a -testdir $normaldirectory # The join is necessary because the message can be split on multiple @@ -731,7 +731,7 @@ removeFile thisdirectoryisafile removeDirectory normaldirectory # -file, -notfile, [matchFiles], [skipFiles] -test tcltest-9.1 {-file d*.tcl} -constraints {unixOrPc} -setup { +test tcltest-9.1 {-file d*.tcl} -constraints {unixOrWin} -setup { set old [testsDirectory] testsDirectory [file dirname [info script]] } -body { @@ -741,7 +741,7 @@ test tcltest-9.1 {-file d*.tcl} -constraints {unixOrPc} -setup { testsDirectory $old } -match regexp -result {dstring\.test} -test tcltest-9.2 {-file d*.tcl} -constraints {unixOrPc} -setup { +test tcltest-9.2 {-file d*.tcl} -constraints {unixOrWin} -setup { set old [testsDirectory] testsDirectory [file dirname [info script]] } -body { @@ -806,23 +806,23 @@ set mc [makeFile { } makecore.tcl] cd [temporaryDirectory] -test tcltest-10.1 {-preservecore 0} {unixOrPc} { +test tcltest-10.1 {-preservecore 0} {unixOrWin} { slave msg $mc -preservecore 0 file delete core regexp "Core file produced" $msg } {0} -test tcltest-10.2 {-preservecore 1} {unixOrPc} { +test tcltest-10.2 {-preservecore 1} {unixOrWin} { slave msg $mc -preservecore 1 file delete core regexp "Core file produced" $msg } {1} -test tcltest-10.3 {-preservecore 2} {unixOrPc} { +test tcltest-10.3 {-preservecore 2} {unixOrWin} { slave msg $mc -preservecore 2 file delete core list [regexp "Core file produced" $msg] [regexp "Moving file to" $msg] \ [regexp "core-" $msg] [file delete core-makecore] } {1 1 1 {}} -test tcltest-10.4 {-preservecore 3} {unixOrPc} { +test tcltest-10.4 {-preservecore 3} {unixOrWin} { slave msg $mc -preservecore 3 file delete core list [regexp "Core file produced" $msg] [regexp "Moving file to" $msg] \ @@ -853,13 +853,13 @@ set contents { } set loadfile [makeFile $contents load.tcl] -test tcltest-12.1 {-load xxx} {unixOrPc} { +test tcltest-12.1 {-load xxx} {unixOrWin} { slave msg $loadfile -load xxx return $msg } {xxx} # Using child process because of -debug usage. -test tcltest-12.2 {-loadfile load.tcl} {unixOrPc} { +test tcltest-12.2 {-loadfile load.tcl} {unixOrWin} { catch {exec [interpreter] $loadfile -debug 2 -loadfile $loadfile} msg list \ [regexp {tcltest} [join [list $msg] [split $msg \n]]] \ @@ -950,7 +950,7 @@ set allfile [makeFile { cd [workingDirectory] test tcltest-14.1 {-singleproc - single process} { - -constraints {unixOrPc} + -constraints {unixOrWin} -body { slave msg $allfile -singleproc 0 -tmpdir [temporaryDirectory] return $msg @@ -960,7 +960,7 @@ test tcltest-14.1 {-singleproc - single process} { } test tcltest-14.2 {-singleproc - multiple process} { - -constraints {unixOrPc} + -constraints {unixOrWin} -body { slave msg $allfile -singleproc 1 -tmpdir [temporaryDirectory] return $msg @@ -1024,7 +1024,7 @@ makeFile { } all.tcl $dtd3 test tcltest-15.1 {basic directory walking} { - -constraints {unixOrPc} + -constraints {unixOrWin} -body { if {[slave msg \ [file join $dtd all.tcl] \ @@ -1038,7 +1038,7 @@ test tcltest-15.1 {basic directory walking} { } test tcltest-15.2 {-asidefromdir} { - -constraints {unixOrPc} + -constraints {unixOrWin} -body { if {[slave msg \ [file join $dtd all.tcl] \ @@ -1056,7 +1056,7 @@ Error: No test files remain after applying your match and skip patterns!$} } test tcltest-15.3 {-relateddir, non-existent dir} { - -constraints {unixOrPc} + -constraints {unixOrWin} -body { if {[slave msg \ [file join $dtd all.tcl] \ @@ -1071,7 +1071,7 @@ test tcltest-15.3 {-relateddir, non-existent dir} { } test tcltest-15.4 {-relateddir, subdir} { - -constraints {unixOrPc} + -constraints {unixOrWin} -body { if {[slave msg \ [file join $dtd all.tcl] \ @@ -1084,7 +1084,7 @@ test tcltest-15.4 {-relateddir, subdir} { -result {Tests located in:.*dirtestdir2.[^23]} } test tcltest-15.5 {-relateddir, -asidefromdir} { - -constraints {unixOrPc} + -constraints {unixOrWin} -body { if {[slave msg \ [file join $dtd all.tcl] \ @@ -1173,7 +1173,7 @@ test tcltest-19.1 {TCLTEST_OPTIONS default} -setup { cd [temporaryDirectory] # PrintError -test tcltest-20.1 {PrintError} {unixOrPc} { +test tcltest-20.1 {PrintError} {unixOrWin} { set result [slave msg $printerror] list $result [regexp "Error: a really short string" $msg] \ [regexp " \"quotes\"" $msg] [regexp " \"Path" $msg] \ @@ -1409,7 +1409,7 @@ makeFile { # Must use a child process because stdout/stderr parsing can't be # duplicated in slave interp. test tcltest-22.1 {runAllTests} { - -constraints {unixOrPc} + -constraints {unixOrWin} -body { exec [interpreter] \ [file join $atd all.tcl] \ -- cgit v0.12 From 15b4eecc823345b12fb41a87076c06a93fffdebd Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 11 Sep 2019 11:10:47 +0000 Subject: Use "package provide Tcl" consistantly, in stead of either "package present Tcl" or "info tclversion"/"info patchlevel" --- library/http/http.tcl | 2 +- library/tm.tcl | 4 ++-- tests/tm.test | 12 ++++++------ 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/library/http/http.tcl b/library/http/http.tcl index ac3b6d5..75898c9 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -1286,7 +1286,7 @@ proc http::Eof {token {force 0}} { if {($state(coding) eq "gzip") && [string length $state(body)] > 0} { if {[catch { - if {[package vsatisfies [package present Tcl] 8.6]} { + if {[package vsatisfies [package provide Tcl] 8.6]} { # The zlib integration into 8.6 includes proper gzip support set state(body) [zlib gunzip $state(body)] } else { diff --git a/library/tm.tcl b/library/tm.tcl index 40b8e40..bab5485 100644 --- a/library/tm.tcl +++ b/library/tm.tcl @@ -309,7 +309,7 @@ proc ::tcl::tm::UnknownHandler {original name args} { proc ::tcl::tm::Defaults {} { global env tcl_platform - lassign [split [info tclversion] .] major minor + regexp {^(\d+)\.(\d+)} [package provide Tcl] - major minor set exe [file normalize [info nameofexecutable]] # Note that we're using [::list], not [list] because [list] means @@ -352,7 +352,7 @@ proc ::tcl::tm::Defaults {} { # Calls 'path add' to paths to the list of module search paths. proc ::tcl::tm::roots {paths} { - regexp {^(\d+)\.(\d+)} [package present Tcl] - major minor + regexp {^(\d+)\.(\d+)} [package provide Tcl] - major minor foreach pa $paths { set p [file join $pa tcl$major] for {set n $minor} {$n >= 0} {incr n -1} { diff --git a/tests/tm.test b/tests/tm.test index 3f93483..001b73e 100644 --- a/tests/tm.test +++ b/tests/tm.test @@ -6,7 +6,7 @@ # Copyright (c) 2004 by Donal K. Fellows. # All rights reserved. -package require Tcl 8.5 +package require Tcl 8.5- if {"::tcltest" ni [namespace children]} { package require tcltest 2 namespace import -force ::tcltest::* @@ -19,12 +19,12 @@ test tm-1.1 {tm: path command exists} { test tm-1.2 {tm: path command syntax} -returnCodes error -body { ::tcl::tm::path foo } -result {unknown or ambiguous subcommand "foo": must be add, list, or remove} -test tm-1.3 {tm: path command syntax} -returnCodes error -body { +test tm-1.3 {tm: path command syntax} { ::tcl::tm::path add -} -result "wrong # args: should be \"::tcl::tm::path add path ...\"" -test tm-1.4 {tm: path command syntax} -returnCodes error -body { +} {} +test tm-1.4 {tm: path command syntax} { ::tcl::tm::path remove -} -result "wrong # args: should be \"::tcl::tm::path remove path ...\"" +} {} test tm-1.5 {tm: path command syntax} -returnCodes error -body { ::tcl::tm::path list foobar } -result "wrong # args: should be \"::tcl::tm::path list\"" @@ -200,7 +200,7 @@ test tm-3.11 {tm: module path management, remove ignores unknown path} -setup { proc genpaths {base} { # Normalizing picks up drive letters on windows [Bug 1053568] set base [file normalize $base] - lassign [split [package present Tcl] .] major minor + regexp {^(\d+)\.(\d+)} [package provide Tcl] - major minor set results {} set base [file join $base tcl$major] lappend results [file join $base site-tcl] -- cgit v0.12 From 56f6e73e6f3bb4c7cf408f25e72f4818914dada3 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 11 Sep 2019 11:49:59 +0000 Subject: windows, close [7de2d722bd]: prefer temp file to check owner and reown it before trying to check in order to avoid dependency on admin with UAC and the setting of "System objects: Default owner for objects created by members of the Administrators group" --- tests/cmdAH.test | 24 ++++++++++++++++++++++-- 1 file changed, 22 insertions(+), 2 deletions(-) diff --git a/tests/cmdAH.test b/tests/cmdAH.test index 03ec3df..563a09e 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -1303,8 +1303,28 @@ test cmdAH-24.20.2 {Tcl_FileObjCmd: mtime 64-bit time_t, bug [4718b41c56]} -cons test cmdAH-25.1 {Tcl_FileObjCmd: owned} { list [catch {file owned a b} msg] $msg } {1 {wrong # args: should be "file owned name"}} -test cmdAH-25.2 {Tcl_FileObjCmd: owned} -constraints win -body { - file owned $gorpfile +test cmdAH-25.2 {Tcl_FileObjCmd: owned} -constraints win -setup { + set fn $gorpfile + # prefer temp file to check owner (try to avoid bug [7de2d722bd]): + if { + [info exists ::env(TEMP)] && [file isdirectory $::env(TEMP)] && + [file dirname $fn] ne [file normalize $::env(TEMP)] + } { + set fn [file join $::env(TEMP)/test-owner-from-tcl.txt] + set fn [makeFile "data" test-owner-from-tcl.txt $::env(TEMP)] + } + # be sure we have really owned this file before trying to check that + # (avoid dependency on admin with UAC and the setting "System objects: + # Default owner for objects created by members of the Administrators group"): + catch { + exec takeown /F [file nativename $fn] + } +} -body { + file owned $fn +} -cleanup { + if {$fn ne $gorpfile} { + removeFile $fn + } } -result 1 test cmdAH-25.2.1 {Tcl_FileObjCmd: owned} -constraints unix -setup { # Avoid problems with AFS -- cgit v0.12 From a9c3a55803118f3a310d26507bc61ea632bedea6 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 11 Sep 2019 19:10:05 +0000 Subject: partially cherrypick of [ecf524bce0], bug-fec0c17d39-8.6-limit: ultimate fix for [fec0c17d39] - avoid SO on deeply recursive call stack by restriction of nested compilations using same limit (interp recursionlimit) like the evaluation, this must protect against unexpected stack exhaustion; conflicts resolved, tests fixed (no command `try` in 8.5) --- generic/tclCompile.c | 25 +++++++++++++++++++++++-- tests/compile.test | 50 ++++++++++++++++++++++++++++++++++++++++---------- 2 files changed, 63 insertions(+), 12 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index eeee1b0..e8c3dd1 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1218,12 +1218,32 @@ TclCompileScript( ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr; int *wlines, wlineat, cmdLine; int* clNext; - Tcl_Parse *parsePtr = (Tcl_Parse *) - TclStackAlloc(interp, sizeof(Tcl_Parse)); + Tcl_Parse *parsePtr; if (envPtr->iPtr == NULL) { Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv"); } + /* + * Check depth to avoid overflow of the C execution stack by too many + * nested calls of TclCompileScript (considering interp recursionlimit). + * Factor 5/4 (1.25) is used to avoid too mistaken limit recognition + * during "mixed" evaluation and compilation process (nested eval+compile) + * and is good enough for default recursionlimit (1000). + */ + if (iPtr->numLevels / 5 > iPtr->maxNestingDepth / 4) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "too many nested compilations (infinite loop?)", -1)); + Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", NULL); + TclCompileSyntaxError(interp, envPtr); + return; + } + /* + * Avoid stack exhaustion by too many nested calls of TclCompileScript + * (considering interp recursionlimit). + */ + iPtr->numLevels++; + + parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse)); Tcl_DStringInit(&ds); @@ -1631,6 +1651,7 @@ TclCompileScript( TclEmitPush(TclAddLiteralObj(envPtr, Tcl_NewObj(), NULL), envPtr); } + iPtr->numLevels--; TclStackFree(interp, parsePtr); Tcl_DStringFree(&ds); } diff --git a/tests/compile.test b/tests/compile.test index a66da22..f027197 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -424,10 +424,13 @@ test compile-13.1 {testing underestimate of maxStackSize in list cmd} {exec} { # Tests of nested compile (body in body compilation), should not generate stack overflow # (with abnormal program termination), bug [fec0c17d39]: -test compile-13.2 {TclCompileScript: testing nested scripts compilation} -setup { - set i [interp create] - interp recursionlimit $i [expr {10000+50}] - $i eval {proc gencode {nr {cmd eval} {nl 0}} { +proc _ti_gencode {} { + # creates test interpreter on demand with [gencode] generator: + if {[interp exists ti]} { + return + } + interp create ti + ti eval {proc gencode {nr {cmd eval} {nl 0}} { set code "" set e ""; if {$nl} {set e "\n"} for {set i 0} {$i < $nr} {incr i} { @@ -440,18 +443,45 @@ test compile-13.2 {TclCompileScript: testing nested scripts compilation} -setup #puts [format "%% %.40s ... %d bytes" $code [string length $code]] return $code }} +} +test compile-13.2 {TclCompileScript: testing expected nested scripts compilation} -setup { + _ti_gencode + interp recursionlimit ti [expr {10000+50}] + ti eval {set result {}} } -body { # Test different compilation variants (instructions evalStk, invokeStk, etc), - # with 1500 (750 in debug) nested scripts (bodies). If you get SO/SF exceptions on some low-stack + # with 2000 (1000 in debug) nested scripts (bodies). If you get SO/SF exceptions on some low-stack # boxes or systems, please don't decrease it (either provide a constraint) - $i eval {foreach cmd {eval "if 1" catch} { - set c [gencode [expr {![::tcl::pkgconfig get debug] ? 1500 : 750}] $cmd] + ti eval {foreach cmd {eval "if 1" catch} { + set c [gencode [expr {![::tcl::pkgconfig get debug] ? 2000 : 1000}] $cmd] if 1 $c }} - $i eval {set result} -} -result {1 1 1} -cleanup { - interp delete $i + ti eval {set result} +} -result {1 1 1} +test compile-13.3 {TclCompileScript: testing check of max depth by nested scripts compilation} -setup { + _ti_gencode + interp recursionlimit ti 100 + ti eval {set result {}} +} -body { + # Test different compilation variants (instructions evalStk, invokeStk, etc), + # with 500 nested scripts (bodies). It must generate "too many nested compilations" + # error for any variant we're testing here: + ti eval {foreach cmd {eval "if 1" catch} { + set c [gencode [expr {![info exists ::tcl_platform(debug)] ? 2000 : 1000}] $cmd] + lappend errors [catch $c e] $e + }} + #puts $errors + # all of nested calls exceed the limit, so must end with "too many nested compilations" + # (or evaluations, depending on compile method/instruction and "mixed" compile within + # evaliation), so no one succeeds, the result must be empty: + ti eval {set result} +} -result {} +# +# clean up: +if {[interp exists ti]} { + interp delete ti } +rename _ti_gencode {} # Tests compile-14.* for [Bug 599788] [Bug 0c043a175a47da8c2342] test compile-14.1 {testing errors in element name; segfault?} {} { -- cgit v0.12 From ec00b7a363093fe0fff1b2e93a91091a7a6b06c9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Ignacio=20Mar=C3=ADn?= Date: Thu, 12 Sep 2019 08:00:52 +0000 Subject: Update TZ info to tzdata2019c. --- library/tzdata/America/Detroit | 5 + library/tzdata/America/Edmonton | 4 - library/tzdata/America/Indiana/Tell_City | 16 +-- library/tzdata/America/Kentucky/Louisville | 9 +- library/tzdata/America/Vancouver | 2 +- library/tzdata/Asia/Hong_Kong | 2 +- library/tzdata/Asia/Seoul | 8 ++ library/tzdata/Europe/Brussels | 2 +- library/tzdata/Europe/Istanbul | 57 ++++----- library/tzdata/Europe/Kaliningrad | 9 +- library/tzdata/Europe/Vienna | 2 +- library/tzdata/Pacific/Fiji | 186 ++++++++++++++--------------- library/tzdata/Pacific/Norfolk | 164 ++++++++++++++++++++++++- 13 files changed, 308 insertions(+), 158 deletions(-) diff --git a/library/tzdata/America/Detroit b/library/tzdata/America/Detroit index f725874..2139aa8 100644 --- a/library/tzdata/America/Detroit +++ b/library/tzdata/America/Detroit @@ -11,6 +11,11 @@ set TZData(:America/Detroit) { {-757364400 -18000 0 EST} {-684349200 -14400 1 EDT} {-671047200 -18000 0 EST} + {-80506740 -14400 0 EDT} + {-68666400 -18000 0 EST} + {-52938000 -14400 1 EDT} + {-37216800 -18000 0 EST} + {-31518000 -18000 0 EST} {94712400 -18000 0 EST} {104914800 -14400 1 EDT} {120636000 -18000 0 EST} diff --git a/library/tzdata/America/Edmonton b/library/tzdata/America/Edmonton index 1ed38be..234b3af 100644 --- a/library/tzdata/America/Edmonton +++ b/library/tzdata/America/Edmonton @@ -20,10 +20,6 @@ set TZData(:America/Edmonton) { {-765388800 -25200 0 MST} {-715791600 -21600 1 MDT} {-702489600 -25200 0 MST} - {-84380400 -21600 1 MDT} - {-68659200 -25200 0 MST} - {-21481200 -21600 1 MDT} - {-5760000 -25200 0 MST} {73472400 -21600 1 MDT} {89193600 -25200 0 MST} {104922000 -21600 1 MDT} diff --git a/library/tzdata/America/Indiana/Tell_City b/library/tzdata/America/Indiana/Tell_City index 9eebcf7..f8014bf 100644 --- a/library/tzdata/America/Indiana/Tell_City +++ b/library/tzdata/America/Indiana/Tell_City @@ -11,12 +11,6 @@ set TZData(:America/Indiana/Tell_City) { {-769395600 -18000 1 CPT} {-765392400 -21600 0 CST} {-757360800 -21600 0 CST} - {-747244800 -18000 1 CDT} - {-733942800 -21600 0 CST} - {-526492800 -18000 1 CDT} - {-513190800 -21600 0 CST} - {-495043200 -18000 1 CDT} - {-481741200 -21600 0 CST} {-462996000 -18000 1 CDT} {-450291600 -21600 0 CST} {-431539200 -18000 1 CDT} @@ -28,16 +22,18 @@ set TZData(:America/Indiana/Tell_City) { {-337190400 -18000 1 CDT} {-323888400 -21600 0 CST} {-305740800 -18000 1 CDT} - {-289414800 -21600 0 CST} + {-292438800 -21600 0 CST} {-273686400 -18000 1 CDT} - {-260989200 -21600 0 CST} + {-257965200 -21600 0 CST} {-242236800 -18000 1 CDT} {-226515600 -21600 0 CST} {-210787200 -18000 1 CDT} {-195066000 -21600 0 CST} {-179337600 -18000 0 EST} - {-31518000 -18000 0 EST} - {-21488400 -14400 1 EDT} + {-68662800 -21600 0 CST} + {-52934400 -18000 1 CDT} + {-37213200 -21600 0 CST} + {-21484800 -14400 0 EDT} {-5767200 -18000 0 EST} {9961200 -14400 1 EDT} {25682400 -18000 0 EST} diff --git a/library/tzdata/America/Kentucky/Louisville b/library/tzdata/America/Kentucky/Louisville index c2aa10c..7efbec9 100644 --- a/library/tzdata/America/Kentucky/Louisville +++ b/library/tzdata/America/Kentucky/Louisville @@ -17,12 +17,9 @@ set TZData(:America/Kentucky/Louisville) { {-769395600 -18000 1 CPT} {-765392400 -21600 0 CST} {-757360800 -21600 0 CST} - {-747244800 -18000 1 CDT} + {-747251940 -18000 1 CDT} {-744224400 -21600 0 CST} - {-715795200 -18000 1 CDT} - {-684349200 -18000 1 CDT} - {-652899600 -18000 1 CDT} - {-620845200 -18000 1 CDT} + {-620841600 -18000 1 CDT} {-608144400 -21600 0 CST} {-589392000 -18000 1 CDT} {-576090000 -21600 0 CST} @@ -45,7 +42,7 @@ set TZData(:America/Kentucky/Louisville) { {-305740800 -18000 1 CDT} {-289414800 -21600 0 CST} {-273686400 -18000 1 CDT} - {-266432400 -18000 0 EST} + {-266428800 -18000 0 EST} {-63140400 -18000 0 EST} {-52938000 -14400 1 EDT} {-37216800 -18000 0 EST} diff --git a/library/tzdata/America/Vancouver b/library/tzdata/America/Vancouver index aef639a..795e9e0 100644 --- a/library/tzdata/America/Vancouver +++ b/library/tzdata/America/Vancouver @@ -9,7 +9,7 @@ set TZData(:America/Vancouver) { {-769395600 -25200 1 PPT} {-765385200 -28800 0 PST} {-747237600 -25200 1 PDT} - {-732726000 -28800 0 PST} + {-733935600 -28800 0 PST} {-715788000 -25200 1 PDT} {-702486000 -28800 0 PST} {-684338400 -25200 1 PDT} diff --git a/library/tzdata/Asia/Hong_Kong b/library/tzdata/Asia/Hong_Kong index 9420142..8f5ed2c 100644 --- a/library/tzdata/Asia/Hong_Kong +++ b/library/tzdata/Asia/Hong_Kong @@ -4,7 +4,7 @@ set TZData(:Asia/Hong_Kong) { {-9223372036854775808 27402 0 LMT} {-2056690800 28800 0 HKT} {-900910800 32400 1 HKST} - {-891579600 30600 0 HKT} + {-891579600 30600 1 HKWT} {-884248200 32400 0 JST} {-761209200 28800 0 HKT} {-747907200 32400 1 HKST} diff --git a/library/tzdata/Asia/Seoul b/library/tzdata/Asia/Seoul index b226eb5..2df8adc 100644 --- a/library/tzdata/Asia/Seoul +++ b/library/tzdata/Asia/Seoul @@ -5,6 +5,14 @@ set TZData(:Asia/Seoul) { {-1948782472 30600 0 KST} {-1830414600 32400 0 JST} {-767350800 32400 0 KST} + {-681210000 36000 1 KDT} + {-672228000 32400 0 KST} + {-654771600 36000 1 KDT} + {-640864800 32400 0 KST} + {-623408400 36000 1 KDT} + {-609415200 32400 0 KST} + {-588848400 36000 1 KDT} + {-577965600 32400 0 KST} {-498128400 30600 0 KST} {-462702600 34200 1 KDT} {-451733400 30600 0 KST} diff --git a/library/tzdata/Europe/Brussels b/library/tzdata/Europe/Brussels index 3cb9b14..907fff8 100644 --- a/library/tzdata/Europe/Brussels +++ b/library/tzdata/Europe/Brussels @@ -3,7 +3,7 @@ set TZData(:Europe/Brussels) { {-9223372036854775808 1050 0 LMT} {-2840141850 1050 0 BMT} - {-2450953050 0 0 WET} + {-2450995200 0 0 WET} {-1740355200 3600 0 CET} {-1693702800 7200 0 CEST} {-1680483600 3600 0 CET} diff --git a/library/tzdata/Europe/Istanbul b/library/tzdata/Europe/Istanbul index d00533f..a4b9b89 100644 --- a/library/tzdata/Europe/Istanbul +++ b/library/tzdata/Europe/Istanbul @@ -16,13 +16,11 @@ set TZData(:Europe/Istanbul) { {-1428030000 7200 0 EET} {-1409709600 10800 1 EEST} {-1396494000 7200 0 EET} - {-931140000 10800 1 EEST} - {-922762800 7200 0 EET} + {-931053600 10800 1 EEST} + {-922676400 7200 0 EET} {-917834400 10800 1 EEST} {-892436400 7200 0 EET} {-875844000 10800 1 EEST} - {-857358000 7200 0 EET} - {-781063200 10800 1 EEST} {-764737200 7200 0 EET} {-744343200 10800 1 EEST} {-733806000 7200 0 EET} @@ -32,45 +30,32 @@ set TZData(:Europe/Istanbul) { {-670474800 7200 0 EET} {-654141600 10800 1 EEST} {-639025200 7200 0 EET} - {-621828000 10800 1 EEST} + {-622087200 10800 1 EEST} {-606970800 7200 0 EET} {-590032800 10800 1 EEST} - {-575434800 7200 0 EET} + {-575521200 7200 0 EET} {-235620000 10800 1 EEST} - {-228279600 7200 0 EET} + {-194842800 7200 0 EET} {-177732000 10800 1 EEST} {-165726000 7200 0 EET} - {10533600 10800 1 EEST} - {23835600 7200 0 EET} - {41983200 10800 1 EEST} - {55285200 7200 0 EET} - {74037600 10800 1 EEST} - {87339600 7200 0 EET} {107910000 10800 1 EEST} - {121219200 7200 0 EET} + {121215600 7200 0 EET} {133920000 10800 1 EEST} - {152676000 7200 0 EET} - {165362400 10800 1 EEST} - {183502800 7200 0 EET} - {202428000 10800 1 EEST} - {215557200 7200 0 EET} - {228866400 10800 1 EEST} - {245797200 7200 0 EET} - {260316000 10800 1 EEST} - {277246800 14400 0 +04} - {291769200 14400 1 +04} - {308779200 10800 0 +03} - {323827200 14400 1 +04} - {340228800 10800 0 +03} - {354672000 14400 1 +04} - {371678400 10800 0 +03} - {386121600 14400 1 +04} - {403128000 10800 0 +03} - {428446800 14400 1 +04} - {433886400 10800 0 +03} - {482792400 7200 0 EET} - {482796000 10800 1 EEST} - {496702800 7200 0 EET} + {152665200 7200 0 EET} + {164678400 10800 1 EEST} + {184114800 7200 0 EET} + {196214400 10800 1 EEST} + {215564400 7200 0 EET} + {228873600 10800 1 EEST} + {245804400 7200 0 EET} + {260323200 10800 1 EEST} + {267919200 10800 0 +03} + {277254000 10800 0 +03} + {428454000 14400 1 +04} + {433893600 10800 0 +03} + {468111600 7200 0 EET} + {482799600 10800 1 EEST} + {496710000 7200 0 EET} {512521200 10800 1 EEST} {528246000 7200 0 EET} {543970800 10800 1 EEST} diff --git a/library/tzdata/Europe/Kaliningrad b/library/tzdata/Europe/Kaliningrad index e1713ae..2ce7f35 100644 --- a/library/tzdata/Europe/Kaliningrad +++ b/library/tzdata/Europe/Kaliningrad @@ -15,10 +15,11 @@ set TZData(:Europe/Kaliningrad) { {-828226800 3600 0 CET} {-812502000 7200 1 CEST} {-796777200 3600 0 CET} - {-788922000 7200 0 CET} - {-778730400 10800 1 CEST} - {-762663600 7200 0 CET} - {-757389600 10800 0 MSD} + {-781052400 7200 1 CEST} + {-780368400 7200 0 EET} + {-778730400 10800 1 EEST} + {-762663600 7200 0 EET} + {-749095200 10800 0 MSD} {354920400 14400 1 MSD} {370728000 10800 0 MSK} {386456400 14400 1 MSD} diff --git a/library/tzdata/Europe/Vienna b/library/tzdata/Europe/Vienna index 95283eb..3fdad03 100644 --- a/library/tzdata/Europe/Vienna +++ b/library/tzdata/Europe/Vienna @@ -22,7 +22,7 @@ set TZData(:Europe/Vienna) { {-780188400 3600 0 CET} {-757386000 3600 0 CET} {-748479600 7200 1 CEST} - {-733359600 3600 0 CET} + {-733273200 3600 0 CET} {-717634800 7200 1 CEST} {-701910000 3600 0 CET} {-684975600 7200 1 CEST} diff --git a/library/tzdata/Pacific/Fiji b/library/tzdata/Pacific/Fiji index b05985c..e316b93 100644 --- a/library/tzdata/Pacific/Fiji +++ b/library/tzdata/Pacific/Fiji @@ -27,165 +27,165 @@ set TZData(:Pacific/Fiji) { {1515852000 43200 0 +12} {1541253600 46800 1 +12} {1547301600 43200 0 +12} - {1572703200 46800 1 +12} - {1579356000 43200 0 +12} - {1604152800 46800 1 +12} + {1573308000 46800 1 +12} + {1578751200 43200 0 +12} + {1604757600 46800 1 +12} {1610805600 43200 0 +12} - {1636207200 46800 1 +12} + {1636812000 46800 1 +12} {1642255200 43200 0 +12} - {1667656800 46800 1 +12} + {1668261600 46800 1 +12} {1673704800 43200 0 +12} - {1699106400 46800 1 +12} + {1699711200 46800 1 +12} {1705154400 43200 0 +12} - {1730556000 46800 1 +12} - {1737208800 43200 0 +12} - {1762005600 46800 1 +12} + {1731160800 46800 1 +12} + {1736604000 43200 0 +12} + {1762610400 46800 1 +12} {1768658400 43200 0 +12} - {1793455200 46800 1 +12} + {1794060000 46800 1 +12} {1800108000 43200 0 +12} - {1825509600 46800 1 +12} + {1826114400 46800 1 +12} {1831557600 43200 0 +12} - {1856959200 46800 1 +12} + {1857564000 46800 1 +12} {1863007200 43200 0 +12} - {1888408800 46800 1 +12} + {1889013600 46800 1 +12} {1894456800 43200 0 +12} - {1919858400 46800 1 +12} - {1926511200 43200 0 +12} - {1951308000 46800 1 +12} + {1920463200 46800 1 +12} + {1925906400 43200 0 +12} + {1951912800 46800 1 +12} {1957960800 43200 0 +12} - {1983362400 46800 1 +12} + {1983967200 46800 1 +12} {1989410400 43200 0 +12} - {2014812000 46800 1 +12} + {2015416800 46800 1 +12} {2020860000 43200 0 +12} - {2046261600 46800 1 +12} + {2046866400 46800 1 +12} {2052309600 43200 0 +12} - {2077711200 46800 1 +12} + {2078316000 46800 1 +12} {2083759200 43200 0 +12} - {2109160800 46800 1 +12} + {2109765600 46800 1 +12} {2115813600 43200 0 +12} - {2140610400 46800 1 +12} + {2141215200 46800 1 +12} {2147263200 43200 0 +12} - {2172664800 46800 1 +12} + {2173269600 46800 1 +12} {2178712800 43200 0 +12} - {2204114400 46800 1 +12} + {2204719200 46800 1 +12} {2210162400 43200 0 +12} - {2235564000 46800 1 +12} + {2236168800 46800 1 +12} {2241612000 43200 0 +12} - {2267013600 46800 1 +12} - {2273666400 43200 0 +12} - {2298463200 46800 1 +12} + {2267618400 46800 1 +12} + {2273061600 43200 0 +12} + {2299068000 46800 1 +12} {2305116000 43200 0 +12} - {2329912800 46800 1 +12} + {2330517600 46800 1 +12} {2336565600 43200 0 +12} - {2361967200 46800 1 +12} + {2362572000 46800 1 +12} {2368015200 43200 0 +12} - {2393416800 46800 1 +12} + {2394021600 46800 1 +12} {2399464800 43200 0 +12} - {2424866400 46800 1 +12} + {2425471200 46800 1 +12} {2430914400 43200 0 +12} - {2456316000 46800 1 +12} - {2462968800 43200 0 +12} - {2487765600 46800 1 +12} + {2456920800 46800 1 +12} + {2462364000 43200 0 +12} + {2488370400 46800 1 +12} {2494418400 43200 0 +12} - {2519820000 46800 1 +12} + {2520424800 46800 1 +12} {2525868000 43200 0 +12} - {2551269600 46800 1 +12} + {2551874400 46800 1 +12} {2557317600 43200 0 +12} - {2582719200 46800 1 +12} + {2583324000 46800 1 +12} {2588767200 43200 0 +12} - {2614168800 46800 1 +12} - {2620821600 43200 0 +12} - {2645618400 46800 1 +12} + {2614773600 46800 1 +12} + {2620216800 43200 0 +12} + {2646223200 46800 1 +12} {2652271200 43200 0 +12} - {2677068000 46800 1 +12} + {2677672800 46800 1 +12} {2683720800 43200 0 +12} - {2709122400 46800 1 +12} + {2709727200 46800 1 +12} {2715170400 43200 0 +12} - {2740572000 46800 1 +12} + {2741176800 46800 1 +12} {2746620000 43200 0 +12} - {2772021600 46800 1 +12} + {2772626400 46800 1 +12} {2778069600 43200 0 +12} - {2803471200 46800 1 +12} - {2810124000 43200 0 +12} - {2834920800 46800 1 +12} + {2804076000 46800 1 +12} + {2809519200 43200 0 +12} + {2835525600 46800 1 +12} {2841573600 43200 0 +12} - {2866975200 46800 1 +12} + {2867580000 46800 1 +12} {2873023200 43200 0 +12} - {2898424800 46800 1 +12} + {2899029600 46800 1 +12} {2904472800 43200 0 +12} - {2929874400 46800 1 +12} + {2930479200 46800 1 +12} {2935922400 43200 0 +12} - {2961324000 46800 1 +12} + {2961928800 46800 1 +12} {2967372000 43200 0 +12} - {2992773600 46800 1 +12} + {2993378400 46800 1 +12} {2999426400 43200 0 +12} - {3024223200 46800 1 +12} + {3024828000 46800 1 +12} {3030876000 43200 0 +12} - {3056277600 46800 1 +12} + {3056882400 46800 1 +12} {3062325600 43200 0 +12} - {3087727200 46800 1 +12} + {3088332000 46800 1 +12} {3093775200 43200 0 +12} - {3119176800 46800 1 +12} + {3119781600 46800 1 +12} {3125224800 43200 0 +12} - {3150626400 46800 1 +12} - {3157279200 43200 0 +12} - {3182076000 46800 1 +12} + {3151231200 46800 1 +12} + {3156674400 43200 0 +12} + {3182680800 46800 1 +12} {3188728800 43200 0 +12} - {3213525600 46800 1 +12} + {3214130400 46800 1 +12} {3220178400 43200 0 +12} - {3245580000 46800 1 +12} + {3246184800 46800 1 +12} {3251628000 43200 0 +12} - {3277029600 46800 1 +12} + {3277634400 46800 1 +12} {3283077600 43200 0 +12} - {3308479200 46800 1 +12} + {3309084000 46800 1 +12} {3314527200 43200 0 +12} - {3339928800 46800 1 +12} - {3346581600 43200 0 +12} - {3371378400 46800 1 +12} + {3340533600 46800 1 +12} + {3345976800 43200 0 +12} + {3371983200 46800 1 +12} {3378031200 43200 0 +12} - {3403432800 46800 1 +12} + {3404037600 46800 1 +12} {3409480800 43200 0 +12} - {3434882400 46800 1 +12} + {3435487200 46800 1 +12} {3440930400 43200 0 +12} - {3466332000 46800 1 +12} + {3466936800 46800 1 +12} {3472380000 43200 0 +12} - {3497781600 46800 1 +12} - {3504434400 43200 0 +12} - {3529231200 46800 1 +12} + {3498386400 46800 1 +12} + {3503829600 43200 0 +12} + {3529836000 46800 1 +12} {3535884000 43200 0 +12} - {3560680800 46800 1 +12} + {3561285600 46800 1 +12} {3567333600 43200 0 +12} - {3592735200 46800 1 +12} + {3593340000 46800 1 +12} {3598783200 43200 0 +12} - {3624184800 46800 1 +12} + {3624789600 46800 1 +12} {3630232800 43200 0 +12} - {3655634400 46800 1 +12} + {3656239200 46800 1 +12} {3661682400 43200 0 +12} - {3687084000 46800 1 +12} - {3693736800 43200 0 +12} - {3718533600 46800 1 +12} + {3687688800 46800 1 +12} + {3693132000 43200 0 +12} + {3719138400 46800 1 +12} {3725186400 43200 0 +12} - {3750588000 46800 1 +12} + {3751192800 46800 1 +12} {3756636000 43200 0 +12} - {3782037600 46800 1 +12} + {3782642400 46800 1 +12} {3788085600 43200 0 +12} - {3813487200 46800 1 +12} + {3814092000 46800 1 +12} {3819535200 43200 0 +12} - {3844936800 46800 1 +12} + {3845541600 46800 1 +12} {3850984800 43200 0 +12} - {3876386400 46800 1 +12} + {3876991200 46800 1 +12} {3883039200 43200 0 +12} - {3907836000 46800 1 +12} + {3908440800 46800 1 +12} {3914488800 43200 0 +12} - {3939890400 46800 1 +12} + {3940495200 46800 1 +12} {3945938400 43200 0 +12} - {3971340000 46800 1 +12} + {3971944800 46800 1 +12} {3977388000 43200 0 +12} - {4002789600 46800 1 +12} + {4003394400 46800 1 +12} {4008837600 43200 0 +12} - {4034239200 46800 1 +12} - {4040892000 43200 0 +12} - {4065688800 46800 1 +12} + {4034844000 46800 1 +12} + {4040287200 43200 0 +12} + {4066293600 46800 1 +12} {4072341600 43200 0 +12} - {4097138400 46800 1 +12} + {4097743200 46800 1 +12} } diff --git a/library/tzdata/Pacific/Norfolk b/library/tzdata/Pacific/Norfolk index f0556ab..f686df5 100644 --- a/library/tzdata/Pacific/Norfolk +++ b/library/tzdata/Pacific/Norfolk @@ -5,6 +5,168 @@ set TZData(:Pacific/Norfolk) { {-2177493112 40320 0 +1112} {-599656320 41400 0 +1130} {152029800 45000 1 +1230} - {162912600 41400 0 +1130} + {162916200 41400 0 +1130} {1443882600 39600 0 +11} + {1561899600 39600 0 +12} + {1570287600 43200 1 +12} + {1586012400 39600 0 +12} + {1601737200 43200 1 +12} + {1617462000 39600 0 +12} + {1633186800 43200 1 +12} + {1648911600 39600 0 +12} + {1664636400 43200 1 +12} + {1680361200 39600 0 +12} + {1696086000 43200 1 +12} + {1712415600 39600 0 +12} + {1728140400 43200 1 +12} + {1743865200 39600 0 +12} + {1759590000 43200 1 +12} + {1775314800 39600 0 +12} + {1791039600 43200 1 +12} + {1806764400 39600 0 +12} + {1822489200 43200 1 +12} + {1838214000 39600 0 +12} + {1853938800 43200 1 +12} + {1869663600 39600 0 +12} + {1885993200 43200 1 +12} + {1901718000 39600 0 +12} + {1917442800 43200 1 +12} + {1933167600 39600 0 +12} + {1948892400 43200 1 +12} + {1964617200 39600 0 +12} + {1980342000 43200 1 +12} + {1996066800 39600 0 +12} + {2011791600 43200 1 +12} + {2027516400 39600 0 +12} + {2043241200 43200 1 +12} + {2058966000 39600 0 +12} + {2075295600 43200 1 +12} + {2091020400 39600 0 +12} + {2106745200 43200 1 +12} + {2122470000 39600 0 +12} + {2138194800 43200 1 +12} + {2153919600 39600 0 +12} + {2169644400 43200 1 +12} + {2185369200 39600 0 +12} + {2201094000 43200 1 +12} + {2216818800 39600 0 +12} + {2233148400 43200 1 +12} + {2248873200 39600 0 +12} + {2264598000 43200 1 +12} + {2280322800 39600 0 +12} + {2296047600 43200 1 +12} + {2311772400 39600 0 +12} + {2327497200 43200 1 +12} + {2343222000 39600 0 +12} + {2358946800 43200 1 +12} + {2374671600 39600 0 +12} + {2390396400 43200 1 +12} + {2406121200 39600 0 +12} + {2422450800 43200 1 +12} + {2438175600 39600 0 +12} + {2453900400 43200 1 +12} + {2469625200 39600 0 +12} + {2485350000 43200 1 +12} + {2501074800 39600 0 +12} + {2516799600 43200 1 +12} + {2532524400 39600 0 +12} + {2548249200 43200 1 +12} + {2563974000 39600 0 +12} + {2579698800 43200 1 +12} + {2596028400 39600 0 +12} + {2611753200 43200 1 +12} + {2627478000 39600 0 +12} + {2643202800 43200 1 +12} + {2658927600 39600 0 +12} + {2674652400 43200 1 +12} + {2690377200 39600 0 +12} + {2706102000 43200 1 +12} + {2721826800 39600 0 +12} + {2737551600 43200 1 +12} + {2753276400 39600 0 +12} + {2769606000 43200 1 +12} + {2785330800 39600 0 +12} + {2801055600 43200 1 +12} + {2816780400 39600 0 +12} + {2832505200 43200 1 +12} + {2848230000 39600 0 +12} + {2863954800 43200 1 +12} + {2879679600 39600 0 +12} + {2895404400 43200 1 +12} + {2911129200 39600 0 +12} + {2926854000 43200 1 +12} + {2942578800 39600 0 +12} + {2958908400 43200 1 +12} + {2974633200 39600 0 +12} + {2990358000 43200 1 +12} + {3006082800 39600 0 +12} + {3021807600 43200 1 +12} + {3037532400 39600 0 +12} + {3053257200 43200 1 +12} + {3068982000 39600 0 +12} + {3084706800 43200 1 +12} + {3100431600 39600 0 +12} + {3116761200 43200 1 +12} + {3132486000 39600 0 +12} + {3148210800 43200 1 +12} + {3163935600 39600 0 +12} + {3179660400 43200 1 +12} + {3195385200 39600 0 +12} + {3211110000 43200 1 +12} + {3226834800 39600 0 +12} + {3242559600 43200 1 +12} + {3258284400 39600 0 +12} + {3274009200 43200 1 +12} + {3289734000 39600 0 +12} + {3306063600 43200 1 +12} + {3321788400 39600 0 +12} + {3337513200 43200 1 +12} + {3353238000 39600 0 +12} + {3368962800 43200 1 +12} + {3384687600 39600 0 +12} + {3400412400 43200 1 +12} + {3416137200 39600 0 +12} + {3431862000 43200 1 +12} + {3447586800 39600 0 +12} + {3463311600 43200 1 +12} + {3479641200 39600 0 +12} + {3495366000 43200 1 +12} + {3511090800 39600 0 +12} + {3526815600 43200 1 +12} + {3542540400 39600 0 +12} + {3558265200 43200 1 +12} + {3573990000 39600 0 +12} + {3589714800 43200 1 +12} + {3605439600 39600 0 +12} + {3621164400 43200 1 +12} + {3636889200 39600 0 +12} + {3653218800 43200 1 +12} + {3668943600 39600 0 +12} + {3684668400 43200 1 +12} + {3700393200 39600 0 +12} + {3716118000 43200 1 +12} + {3731842800 39600 0 +12} + {3747567600 43200 1 +12} + {3763292400 39600 0 +12} + {3779017200 43200 1 +12} + {3794742000 39600 0 +12} + {3810466800 43200 1 +12} + {3826191600 39600 0 +12} + {3842521200 43200 1 +12} + {3858246000 39600 0 +12} + {3873970800 43200 1 +12} + {3889695600 39600 0 +12} + {3905420400 43200 1 +12} + {3921145200 39600 0 +12} + {3936870000 43200 1 +12} + {3952594800 39600 0 +12} + {3968319600 43200 1 +12} + {3984044400 39600 0 +12} + {4000374000 43200 1 +12} + {4016098800 39600 0 +12} + {4031823600 43200 1 +12} + {4047548400 39600 0 +12} + {4063273200 43200 1 +12} + {4078998000 39600 0 +12} + {4094722800 43200 1 +12} } -- cgit v0.12 From eaefc3bdf38a0256fca08f8d0b9a2a137cf8706e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 12 Sep 2019 11:01:18 +0000 Subject: Code cleanup: Add some initialization to "Tcl_UniChar ch" declaration, making the chance higher that 4-byte UTF-8 sequences are handled more reasonable internally (see: [https://core.tcl-lang.org/tk/tktview?name=a179564826|a179564826]). Use more TclGetString() in stead of Tcl_GetString(), which is slightly more efficient. --- generic/tclCompile.c | 4 ++-- generic/tclEncoding.c | 43 ++++++++++++++++++++----------------------- generic/tclUtil.c | 16 ++++++++-------- 3 files changed, 30 insertions(+), 33 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 680ab66..41c81af 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -2126,7 +2126,7 @@ TclCompileScript( if (envPtr->iPtr == NULL) { Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv"); } - /* + /* * Check depth to avoid overflow of the C execution stack by too many * nested calls of TclCompileScript (considering interp recursionlimit). * Factor 5/4 (1.25) is used to avoid too mistaken limit recognition @@ -2218,7 +2218,7 @@ TclCompileScript( continue; } - /* + /* * Avoid stack exhaustion by too many nested calls of TclCompileScript * (considering interp recursionlimit). */ diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 144954b..002c765 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -305,7 +305,7 @@ Tcl_GetEncodingFromObj( Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr) { - const char *name = Tcl_GetString(objPtr); + const char *name = TclGetString(objPtr); if (objPtr->typePtr != &encodingType) { Tcl_Encoding encoding = Tcl_GetEncoding(interp, name); @@ -704,7 +704,7 @@ Tcl_GetDefaultEncodingDir(void) } Tcl_ListObjIndex(NULL, searchPath, 0, &first); - return Tcl_GetString(first); + return TclGetString(first); } /* @@ -1260,7 +1260,7 @@ Tcl_ExternalToUtf( if (*dstCharsPtr <= maxChars) { break; } - dstLen = Tcl_UtfAtIndex(dst, maxChars) - 1 - dst + TCL_UTF_MAX; + dstLen = Tcl_UtfAtIndex(dst, maxChars) - dst + (TCL_UTF_MAX - 1); flags = savedFlags; *statePtr = savedState; } while (1); @@ -1518,10 +1518,10 @@ OpenEncodingFileChannel( } } if (!verified) { - const char *dirString = Tcl_GetString(directory); + const char *dirString = TclGetString(directory); for (i=0; itoUnicode[hi] = pageMemPtr; p += 2; @@ -2054,13 +2054,13 @@ LoadEscapeEncoding( + Tcl_DStringLength(&escapeData); dataPtr = ckalloc(size); dataPtr->initLen = strlen(init); - memcpy(dataPtr->init, init, (unsigned) dataPtr->initLen + 1); + memcpy(dataPtr->init, init, dataPtr->initLen + 1); dataPtr->finalLen = strlen(final); - memcpy(dataPtr->final, final, (unsigned) dataPtr->finalLen + 1); + memcpy(dataPtr->final, final, dataPtr->finalLen + 1); dataPtr->numSubTables = Tcl_DStringLength(&escapeData) / sizeof(EscapeSubTable); memcpy(dataPtr->subTables, Tcl_DStringValue(&escapeData), - (size_t) Tcl_DStringLength(&escapeData)); + Tcl_DStringLength(&escapeData)); Tcl_DStringFree(&escapeData); memset(dataPtr->prefixBytes, 0, sizeof(dataPtr->prefixBytes)); @@ -2148,7 +2148,7 @@ BinaryProc( *srcReadPtr = srcLen; *dstWrotePtr = srcLen; *dstCharsPtr = srcLen; - memcpy(dst, src, (size_t) srcLen); + memcpy(dst, src, srcLen); return result; } @@ -2425,11 +2425,8 @@ UnicodeToUtfProc( const char *srcStart, *srcEnd; const char *dstEnd, *dstStart; int result, numChars, charLimit = INT_MAX; - Tcl_UniChar *chPtr = (Tcl_UniChar *) statePtr; + Tcl_UniChar ch; - if (flags & TCL_ENCODING_START) { - *statePtr = 0; - } if (flags & TCL_ENCODING_CHAR_LIMIT) { charLimit = *dstCharsPtr; } @@ -2457,11 +2454,11 @@ UnicodeToUtfProc( * Tcl_UniChar-size data. */ - *chPtr = *(Tcl_UniChar *)src; - if (*chPtr && *chPtr < 0x80) { - *dst++ = (*chPtr & 0xFF); + ch = *(Tcl_UniChar *)src; + if (ch && ch < 0x80) { + *dst++ = (ch & 0xFF); } else { - dst += Tcl_UniCharToUtf(*chPtr, dst); + dst += Tcl_UniCharToUtf(ch, dst); } src += sizeof(Tcl_UniChar); } @@ -2953,6 +2950,7 @@ Iso88591FromUtfProc( const char *srcStart, *srcEnd, *srcClose; const char *dstStart, *dstEnd; int result, numChars; + Tcl_UniChar ch = 0; result = TCL_OK; @@ -2967,7 +2965,6 @@ Iso88591FromUtfProc( dstEnd = dst + dstLen - 1; for (numChars = 0; src < srcEnd; numChars++) { - Tcl_UniChar ch = 0; int len; if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) { @@ -3321,6 +3318,7 @@ EscapeFromUtfProc( const TableEncodingData *tableDataPtr; const char *tablePrefixBytes; const unsigned short *const *tableFromUnicode; + Tcl_UniChar ch = 0; result = TCL_OK; @@ -3346,7 +3344,7 @@ EscapeFromUtfProc( *dstWrotePtr = 0; return TCL_CONVERT_NOSPACE; } - memcpy(dst, dataPtr->init, (size_t)dataPtr->initLen); + memcpy(dst, dataPtr->init, dataPtr->initLen); dst += dataPtr->initLen; } else { state = PTR2INT(*statePtr); @@ -3361,7 +3359,6 @@ EscapeFromUtfProc( for (numChars = 0; src < srcEnd; numChars++) { unsigned len; int word; - Tcl_UniChar ch = 0; if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) { /* @@ -3468,7 +3465,7 @@ EscapeFromUtfProc( memcpy(dst, dataPtr->subTables[0].sequence, len); dst += len; } - memcpy(dst, dataPtr->final, (size_t) dataPtr->finalLen); + memcpy(dst, dataPtr->final, dataPtr->finalLen); dst += dataPtr->finalLen; state &= ~TCL_ENCODING_END; } diff --git a/generic/tclUtil.c b/generic/tclUtil.c index fc5a2ac..941a71d 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -1725,7 +1725,7 @@ TrimRight( */ do { - Tcl_UniChar ch1; + Tcl_UniChar ch1 = 0; const char *q = trim; int bytesLeft = numTrim; @@ -1737,7 +1737,7 @@ TrimRight( */ do { - Tcl_UniChar ch2; + Tcl_UniChar ch2 = 0; int qInc = TclUtfToUniChar(q, &ch2); if (ch1 == ch2) { @@ -1824,7 +1824,7 @@ TrimLeft( */ do { - Tcl_UniChar ch1; + Tcl_UniChar ch1 = 0; int pInc = TclUtfToUniChar(p, &ch1); const char *q = trim; int bytesLeft = numTrim; @@ -1834,7 +1834,7 @@ TrimLeft( */ do { - Tcl_UniChar ch2; + Tcl_UniChar ch2 = 0; int qInc = TclUtfToUniChar(q, &ch2); if (ch1 == ch2) { @@ -2237,7 +2237,7 @@ Tcl_StringCaseMatch( { int p, charLen; const char *pstart = pattern; - Tcl_UniChar ch1, ch2; + Tcl_UniChar ch1 = 0, ch2 = 0; while (1) { p = *pattern; @@ -2347,7 +2347,7 @@ Tcl_StringCaseMatch( */ if (p == '[') { - Tcl_UniChar startChar, endChar; + Tcl_UniChar startChar = 0, endChar = 0; pattern++; if (UCHAR(*str) < 0x80) { @@ -3069,7 +3069,7 @@ Tcl_DStringGetResult( dsPtr->length = 0; dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE; } else { - dsPtr->string = Tcl_GetString(iPtr->objResultPtr); + dsPtr->string = TclGetString(iPtr->objResultPtr); dsPtr->length = iPtr->objResultPtr->length; dsPtr->spaceAvl = dsPtr->length + 1; TclFreeIntRep(iPtr->objResultPtr); @@ -3754,7 +3754,7 @@ TclGetIntForIndex( parseError: if (interp != NULL) { - bytes = Tcl_GetString(objPtr); + bytes = TclGetString(objPtr); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad index \"%s\": must be integer?[+-]integer? or" " end?[+-]integer?", bytes)); -- cgit v0.12 From 5c782902a038db957c312ccea67a142d076cd414 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 12 Sep 2019 14:12:11 +0000 Subject: More code cleanup: Move more Tcl_UniChar initializations out of the loop. Remove unnecessary type-casts --- generic/tclUtil.c | 51 ++++++++++++++++++++++++--------------------------- 1 file changed, 24 insertions(+), 27 deletions(-) diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 941a71d..61c1973 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -901,7 +901,7 @@ Tcl_SplitList( } argv[i] = p; if (literal) { - memcpy(p, element, (size_t) elSize); + memcpy(p, element, elSize); p += elSize; *p = 0; p++; @@ -939,8 +939,8 @@ Tcl_SplitList( int Tcl_ScanElement( - register const char *src, /* String to convert to list element. */ - register int *flagPtr) /* Where to store information to guide + const char *src, /* String to convert to list element. */ + int *flagPtr) /* Where to store information to guide * Tcl_ConvertCountedElement. */ { return Tcl_ScanCountedElement(src, -1, flagPtr); @@ -1319,9 +1319,9 @@ TclScanElement( int Tcl_ConvertElement( - register const char *src, /* Source information for list element. */ - register char *dst, /* Place to put list-ified element. */ - register int flags) /* Flags produced by Tcl_ScanElement. */ + const char *src, /* Source information for list element. */ + char *dst, /* Place to put list-ified element. */ + int flags) /* Flags produced by Tcl_ScanElement. */ { return Tcl_ConvertCountedElement(src, -1, dst, flags); } @@ -1349,7 +1349,7 @@ Tcl_ConvertElement( int Tcl_ConvertCountedElement( - register const char *src, /* Source information for list element. */ + const char *src, /* Source information for list element. */ int length, /* Number of bytes in src, or -1. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ @@ -1382,7 +1382,7 @@ Tcl_ConvertCountedElement( int TclConvertElement( - register const char *src, /* Source information for list element. */ + const char *src, /* Source information for list element. */ int length, /* Number of bytes in src, or -1. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ @@ -1719,13 +1719,13 @@ TrimRight( { const char *p = bytes + numBytes; int pInc; + Tcl_UniChar ch1 = 0, ch2 = 0; /* * Outer loop: iterate over string to be trimmed. */ do { - Tcl_UniChar ch1 = 0; const char *q = trim; int bytesLeft = numTrim; @@ -1737,7 +1737,6 @@ TrimRight( */ do { - Tcl_UniChar ch2 = 0; int qInc = TclUtfToUniChar(q, &ch2); if (ch1 == ch2) { @@ -1818,13 +1817,13 @@ TrimLeft( int numTrim) /* ...and its length in bytes */ { const char *p = bytes; + Tcl_UniChar ch1 = 0, ch2 = 0; /* * Outer loop: iterate over string to be trimmed. */ do { - Tcl_UniChar ch1 = 0; int pInc = TclUtfToUniChar(p, &ch1); const char *q = trim; int bytesLeft = numTrim; @@ -1834,7 +1833,6 @@ TrimLeft( */ do { - Tcl_UniChar ch2 = 0; int qInc = TclUtfToUniChar(q, &ch2); if (ch1 == ch2) { @@ -2012,7 +2010,7 @@ Tcl_Concat( * All element bytes + (argc - 1) spaces + 1 terminating NULL. */ - result = ckalloc((unsigned) (bytesNeeded + argc)); + result = ckalloc(bytesNeeded + argc); for (p = result, i = 0; i < argc; i++) { int triml, trimr, elemLength; @@ -2045,7 +2043,7 @@ Tcl_Concat( if (needSpace) { *p++ = ' '; } - memcpy(p, element, (size_t) elemLength); + memcpy(p, element, elemLength); p += elemLength; needSpace = 1; } @@ -2747,7 +2745,7 @@ Tcl_DStringAppend( if (dsPtr->string == dsPtr->staticSpace) { char *newString = ckalloc(dsPtr->spaceAvl); - memcpy(newString, dsPtr->string, (size_t) dsPtr->length); + memcpy(newString, dsPtr->string, dsPtr->length); dsPtr->string = newString; } else { int offset = -1; @@ -2850,7 +2848,7 @@ Tcl_DStringAppendElement( if (dsPtr->string == dsPtr->staticSpace) { char *newString = ckalloc(dsPtr->spaceAvl); - memcpy(newString, dsPtr->string, (size_t) dsPtr->length); + memcpy(newString, dsPtr->string, dsPtr->length); dsPtr->string = newString; } else { int offset = -1; @@ -2944,7 +2942,7 @@ Tcl_DStringSetLength( if (dsPtr->string == dsPtr->staticSpace) { char *newString = ckalloc(dsPtr->spaceAvl); - memcpy(newString, dsPtr->string, (size_t) dsPtr->length); + memcpy(newString, dsPtr->string, dsPtr->length); dsPtr->string = newString; } else { dsPtr->string = ckrealloc(dsPtr->string, dsPtr->spaceAvl); @@ -3048,7 +3046,7 @@ Tcl_DStringGetResult( /* * Do more efficient transfer when we know the result is a Tcl_Obj. When - * there's no st`ring result, we only have to deal with two cases: + * there's no string result, we only have to deal with two cases: * * 1. When the string rep is the empty string, when we don't copy but * instead use the staticSpace in the DString to hold an empty string. @@ -3093,7 +3091,7 @@ Tcl_DStringGetResult( dsPtr->spaceAvl = dsPtr->length+1; } else { dsPtr->string = ckalloc(dsPtr->length+1); - memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1); + memcpy(dsPtr->string, iPtr->result, dsPtr->length+1); iPtr->freeProc(iPtr->result); } dsPtr->spaceAvl = dsPtr->length+1; @@ -3106,7 +3104,7 @@ Tcl_DStringGetResult( dsPtr->string = ckalloc(dsPtr->length+1); dsPtr->spaceAvl = dsPtr->length + 1; } - memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1); + memcpy(dsPtr->string, iPtr->result, dsPtr->length+1); } iPtr->result = iPtr->resultSpace; @@ -3261,7 +3259,7 @@ Tcl_PrintDouble( int signum; char *digits; char *end; - int *precisionPtr = Tcl_GetThreadData(&precisionKey, (int) sizeof(int)); + int *precisionPtr = Tcl_GetThreadData(&precisionKey, sizeof(int)); /* * Handle NaN. @@ -4100,7 +4098,7 @@ TclCheckBadOctal( * errors. */ const char *value) /* String to check. */ { - register const char *p = value; + const char *p = value; /* * A frequent mistake is invalid octal values due to an unwanted leading @@ -4291,7 +4289,7 @@ TclSetProcessGlobalValue( } bytes = Tcl_GetStringFromObj(newValue, &pgvPtr->numBytes); pgvPtr->value = ckalloc(pgvPtr->numBytes + 1); - memcpy(pgvPtr->value, bytes, (unsigned) pgvPtr->numBytes + 1); + memcpy(pgvPtr->value, bytes, pgvPtr->numBytes + 1); if (pgvPtr->encoding) { Tcl_FreeEncoding(pgvPtr->encoding); } @@ -4347,8 +4345,7 @@ TclGetProcessGlobalValue( Tcl_DString native, newValue; Tcl_MutexLock(&pgvPtr->mutex); - pgvPtr->epoch++; - epoch = pgvPtr->epoch; + epoch = ++pgvPtr->epoch; Tcl_UtfToExternalDString(pgvPtr->encoding, pgvPtr->value, pgvPtr->numBytes, &native); Tcl_ExternalToUtfDString(current, Tcl_DStringValue(&native), @@ -4357,7 +4354,7 @@ TclGetProcessGlobalValue( ckfree(pgvPtr->value); pgvPtr->value = ckalloc(Tcl_DStringLength(&newValue) + 1); memcpy(pgvPtr->value, Tcl_DStringValue(&newValue), - (size_t) Tcl_DStringLength(&newValue) + 1); + Tcl_DStringLength(&newValue) + 1); Tcl_DStringFree(&newValue); Tcl_FreeEncoding(pgvPtr->encoding); pgvPtr->encoding = current; @@ -4367,7 +4364,7 @@ TclGetProcessGlobalValue( } } cacheMap = GetThreadHash(&pgvPtr->key); - hPtr = Tcl_FindHashEntry(cacheMap, (char *) INT2PTR(epoch)); + hPtr = Tcl_FindHashEntry(cacheMap, INT2PTR(epoch)); if (NULL == hPtr) { int dummy; -- cgit v0.12 From 77286202dda7f636e31cc4623108de8b7471c25b Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 12 Sep 2019 19:12:56 +0000 Subject: windows: eliminate overwriting of WINDIR env-variable in makefiles (used WIN_DIR now similar to "makefile.in"); init.tcl: windows helper prefer SystemRoot if available. --- library/init.tcl | 4 +++- win/makefile.bc | 26 ++++++++++++------------ win/makefile.vc | 60 ++++++++++++++++++++++++++++---------------------------- 3 files changed, 46 insertions(+), 44 deletions(-) diff --git a/library/init.tcl b/library/init.tcl index aaf148b..eb6b04e 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -680,7 +680,9 @@ proc auto_execok name { } set path "[file dirname [info nameof]];.;" - if {[info exists env(WINDIR)]} { + if {[info exists env(SystemRoot)]} { + set windir $env(SystemRoot) + } elseif {[info exists env(WINDIR)]} { set windir $env(WINDIR) } if {[info exists windir]} { diff --git a/win/makefile.bc b/win/makefile.bc index 8f337e3..7881e2c 100644 --- a/win/makefile.bc +++ b/win/makefile.bc @@ -271,10 +271,10 @@ TCLOBJS = \ TCLSTUBOBJS = $(TMPDIR)\tclStubLib.obj -WINDIR = $(ROOT)\win +WIN_DIR = $(ROOT)\win GENERICDIR = $(ROOT)\generic -TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" +TCL_INCLUDES = -I"$(WIN_DIR)" -I"$(GENERICDIR)" TCL_DEFINES = $(DEBUGDEFINES) $(THREADDEFINES) $(SYMDEFINES) \ $(PROFDEFINES) $(OPTDEFINES) $(SIXFOURDEFINES) \ -DTCL_CFGVAL_ENCODING=${CFG_ENCODING} @@ -379,8 +379,8 @@ $(TCLTEST): $(TCLTESTOBJS) $(TCLLIB) $(TMPDIR)\$(NAMEPREFIX)sh.res $(TCLTESTOBJS), $@, -x, $(LNLIBS) $(TCLLIB),, $(TMPDIR)\$(NAMEPREFIX)sh.res ! -$(TCLPIPEDLL): $(WINDIR)\stub16.c - $(cc32) $(CFLAGS) -o$(TMPDIR)\stub16.obj $(WINDIR)\stub16.c +$(TCLPIPEDLL): $(WIN_DIR)\stub16.c + $(cc32) $(CFLAGS) -o$(TMPDIR)\stub16.obj $(WIN_DIR)\stub16.c $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 \ $(TMPDIR)\stub16.obj, $@, -x, $(LNLIBS),, $(TMPDIR)\$(NAMEPREFIX).res @@ -394,7 +394,7 @@ $(TCLREGDLL): $(TMPDIR)\tclWinReg.obj $(TCLSTUBLIB) $(TMPDIR)\tclWinReg.obj, $@, -x, $(LNLIBS) $(TCLSTUBLIB),, \ $(TMPDIR)\$(NAMEPREFIX).res -$(CAT32): $(WINDIR)\cat.c +$(CAT32): $(WIN_DIR)\cat.c $(cc32) $(CONS_CFLAGS) -o$(TMPDIR)\cat.obj $? $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 \ $(TMPDIR)\cat.obj, $@, -x, $(LNLIBS),, @@ -499,10 +499,10 @@ $(TCLRTF): $(MAN2TCL).exe $(TCLSH) # # Special case object file targets # -$(TMPDIR)\tclWinInit.obj: $(WINDIR)\tclWinInit.c +$(TMPDIR)\tclWinInit.obj: $(WIN_DIR)\tclWinInit.c $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$(TMPDIR)\$@ $? -$(TMPDIR)\testMain.obj: $(WINDIR)\tclAppInit.c +$(TMPDIR)\testMain.obj: $(WIN_DIR)\tclAppInit.c $(cc32) $(TCL_CFLAGS) -DTCL_TEST -o$(TMPDIR)\testMain.obj $? $(TMPDIR)\tclTest.obj: $(GENERICDIR)\tclTest.c @@ -511,7 +511,7 @@ $(TMPDIR)\tclTest.obj: $(GENERICDIR)\tclTest.c $(TMPDIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $? -$(TMPDIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c +$(TMPDIR)\tclWinTest.obj: $(WIN_DIR)\tclWinTest.c $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $? $(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c @@ -522,17 +522,17 @@ $(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c -DCFG_RUNTIME_PREFIX=\"$(RUNTIME_PREFIX)\" \ -o$(TMPDIR)\$@ $? -$(TMPDIR)\tclAppInit.obj : $(WINDIR)\tclAppInit.c +$(TMPDIR)\tclAppInit.obj : $(WIN_DIR)\tclAppInit.c $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $? # The following objects should be built using the stub interfaces # tclWinReg: Produces errors in ANSI mode -$(TMPDIR)\tclWinReg.obj : $(WINDIR)\tclWinReg.c +$(TMPDIR)\tclWinReg.obj : $(WIN_DIR)\tclWinReg.c $(cc32) $(TCL_CFLAGS) -DUSE_TCL_STUBS -o$(TMPDIR)\$@ $? # tclWinDde: Produces errors in ANSI mode -$(TMPDIR)\tclWinDde.obj : $(WINDIR)\tclWinDde.c +$(TMPDIR)\tclWinDde.obj : $(WIN_DIR)\tclWinDde.c $(cc32) $(TCL_CFLAGS) -DUSE_TCL_STUBS -o$(TMPDIR)\$@ $? @@ -571,7 +571,7 @@ $(GENERICDIR)\regguts.h: $(GENERICDIR)\regcustom.h # Implicit rules # -{$(WINDIR)}.c{$(TMPDIR)}.obj: +{$(WIN_DIR)}.c{$(TMPDIR)}.obj: $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$@ $< {$(GENERICDIR)}.c{$(TMPDIR)}.obj: @@ -580,7 +580,7 @@ $(GENERICDIR)\regguts.h: $(GENERICDIR)\regcustom.h {$(ROOT)\compat}.c{$(TMPDIR)}.obj: $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$@ $< -{$(WINDIR)}.rc{$(TMPDIR)}.res: +{$(WIN_DIR)}.rc{$(TMPDIR)}.res: $(rc32) $(INCLUDEPATH) -D$(USERDEFINES);$(SYSDEFINES) -fo$@ $< clean: diff --git a/win/makefile.vc b/win/makefile.vc index fc6191f..e2ec8ab 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -413,7 +413,7 @@ DOCDIR = $(ROOT)\doc GENERICDIR = $(ROOT)\generic TOMMATHDIR = $(ROOT)\libtommath TOOLSDIR = $(ROOT)\tools -WINDIR = $(ROOT)\win +WIN_DIR = $(ROOT)\win #--------------------------------------------------------------------- # Compile flags @@ -454,7 +454,7 @@ crt = -MT !endif !endif -TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" -I"$(TOMMATHDIR)" +TCL_INCLUDES = -I"$(WIN_DIR)" -I"$(GENERICDIR)" -I"$(TOMMATHDIR)" TCL_DEFINES = -DTCL_PIPE_DLL=\"$(TCLPIPEDLLNAME)\" -DTCL_TOMMATH -DMP_PREC=4 -Dinline=__inline BASE_CFLAGS = $(cflags) $(cdebug) $(crt) $(TCL_INCLUDES) $(TCL_DEFINES) CON_CFLAGS = $(cflags) $(cdebug) $(crt) -DCONSOLE @@ -574,7 +574,7 @@ $(TCLLIB): $(TCLOBJS) $** << !else - $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tcl -out:$@ \ + $(link32) $(dlllflags) -base:@$(WIN_DIR)\coffbase.txt,tcl -out:$@ \ $(baselibs) @<< $** << @@ -593,8 +593,8 @@ $(TCLTEST): $(TCLTESTOBJS) $(TCLSTUBLIB) $(TCLIMPLIB) $(link32) $(conlflags) -stack:2300000 -out:$@ $(baselibs) $** $(_VC_MANIFEST_EMBED_EXE) -$(TCLPIPEDLL): $(WINDIR)\stub16.c - $(cc32) $(CON_CFLAGS) -Fo$(TMP_DIR)\ $(WINDIR)\stub16.c +$(TCLPIPEDLL): $(WIN_DIR)\stub16.c + $(cc32) $(CON_CFLAGS) -Fo$(TMP_DIR)\ $(WIN_DIR)\stub16.c $(link32) $(conlflags) -out:$@ $(TMP_DIR)\stub16.obj $(baselibs) $(_VC_MANIFEST_EMBED_DLL) @@ -603,7 +603,7 @@ $(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj $(lib32) -nologo $(LINKERFLAGS) -out:$@ $** !else $(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj $(TCLSTUBLIB) - $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tcldde -out:$@ \ + $(link32) $(dlllflags) -base:@$(WIN_DIR)\coffbase.txt,tcldde -out:$@ \ $** $(baselibs) $(_VC_MANIFEST_EMBED_DLL) -@del $*.exp @@ -615,14 +615,14 @@ $(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj $(lib32) -nologo $(LINKERFLAGS) -out:$@ $** !else $(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj $(TCLSTUBLIB) - $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tclreg -out:$@ \ + $(link32) $(dlllflags) -base:@$(WIN_DIR)\coffbase.txt,tclreg -out:$@ \ $** $(baselibs) $(_VC_MANIFEST_EMBED_DLL) -@del $*.exp -@del $*.lib !endif -$(CAT32): $(WINDIR)\cat.c +$(CAT32): $(WIN_DIR)\cat.c $(cc32) $(CON_CFLAGS) -Fo$(TMP_DIR)\ $? $(link32) $(conlflags) -out:$@ -stack:16384 $(TMP_DIR)\cat.obj \ $(baselibs) @@ -774,7 +774,7 @@ install-docs: tclConfig: $(OUT_DIR)\tclConfig.sh -$(OUT_DIR)\tclConfig.sh: $(WINDIR)\tclConfig.sh.in +$(OUT_DIR)\tclConfig.sh: $(WIN_DIR)\tclConfig.sh.in @echo Creating tclConfig.sh @nmakehlp -s << $** >$@ @TCL_DLL_FILE@ $(TCLLIBNAME) @@ -849,7 +849,7 @@ gendate: # Special case object file targets #--------------------------------------------------------------------- -$(TMP_DIR)\testMain.obj: $(WINDIR)\tclAppInit.c +$(TMP_DIR)\testMain.obj: $(WIN_DIR)\tclAppInit.c $(cc32) $(TCL_CFLAGS) -DTCL_TEST \ -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \ -Fo$@ $? @@ -860,7 +860,7 @@ $(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c $(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c $(cc32) $(TCL_CFLAGS) -Fo$@ $? -$(TMP_DIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c +$(TMP_DIR)\tclWinTest.obj: $(WIN_DIR)\tclWinTest.c $(cc32) $(TCL_CFLAGS) -Fo$@ $? $(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c @@ -877,7 +877,7 @@ $(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c -DCFG_RUNTIME_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \ -Fo$@ $? -$(TMP_DIR)\tclAppInit.obj: $(WINDIR)\tclAppInit.c +$(TMP_DIR)\tclAppInit.obj: $(WIN_DIR)\tclAppInit.c $(cc32) $(TCL_CFLAGS) \ -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \ -Fo$@ $? @@ -885,7 +885,7 @@ $(TMP_DIR)\tclAppInit.obj: $(WINDIR)\tclAppInit.c ### The following objects should be built using the stub interfaces ### *ALL* extensions need to built with -DTCL_THREADS=1 -$(TMP_DIR)\tclWinReg.obj: $(WINDIR)\tclWinReg.c +$(TMP_DIR)\tclWinReg.obj: $(WIN_DIR)\tclWinReg.c !if $(STATIC_BUILD) $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -DUNICODE -D_UNICODE -Fo$@ $? !else @@ -893,7 +893,7 @@ $(TMP_DIR)\tclWinReg.obj: $(WINDIR)\tclWinReg.c !endif -$(TMP_DIR)\tclWinDde.obj: $(WINDIR)\tclWinDde.c +$(TMP_DIR)\tclWinDde.obj: $(WIN_DIR)\tclWinDde.c !if $(STATIC_BUILD) $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -DUNICODE -D_UNICODE -Fo$@ $? !else @@ -908,7 +908,7 @@ $(TMP_DIR)\tclWinDde.obj: $(WINDIR)\tclWinDde.c $(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $? -$(TMP_DIR)\tclsh.exe.manifest: $(WINDIR)\tclsh.exe.manifest.in +$(TMP_DIR)\tclsh.exe.manifest: $(WIN_DIR)\tclsh.exe.manifest.in @nmakehlp -s << $** >$@ @MACHINE@ $(MACHINE:IX86=X86) @TCL_WIN_VERSION@ $(DOTVERSION).0.0 @@ -928,7 +928,7 @@ depend: !else $(TCLSH) $(TOOLSDIR:\=/)/mkdepend.tcl -vc32 -out:"$(OUT_DIR)\depend.mk" \ -passthru:"-DBUILD_tcl $(TCL_INCLUDES)" $(GENERICDIR),$$(GENERICDIR) \ - $(COMPATDIR),$$(COMPATDIR) $(TOMMATHDIR),$$(TOMMATHDIR) $(WINDIR),$$(WINDIR) @<< + $(COMPATDIR),$$(COMPATDIR) $(TOMMATHDIR),$$(TOMMATHDIR) $(WIN_DIR),$$(WIN_DIR) @<< $(TCLOBJS) << !endif @@ -952,7 +952,7 @@ $(TCLOBJS) # Implicit rules #--------------------------------------------------------------------- -{$(WINDIR)}.c{$(TMP_DIR)}.obj:: +{$(WIN_DIR)}.c{$(TMP_DIR)}.obj:: $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<< $< << @@ -972,7 +972,7 @@ $< $< << -{$(WINDIR)}.rc{$(TMP_DIR)}.res: +{$(WIN_DIR)}.rc{$(TMP_DIR)}.res: $(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" \ -d DEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \ -d TCL_THREADS=$(TCL_THREADS) \ @@ -1122,18 +1122,18 @@ tidy: clean: @echo Cleaning $(TMP_DIR)\* ... @if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR) - @echo Cleaning $(WINDIR)\nmakehlp.obj ... - @if exist $(WINDIR)\nmakehlp.obj del $(WINDIR)\nmakehlp.obj - @echo Cleaning $(WINDIR)\nmakehlp.exe ... - @if exist $(WINDIR)\nmakehlp.exe del $(WINDIR)\nmakehlp.exe - @echo Cleaning $(WINDIR)\_junk.pch ... - @if exist $(WINDIR)\_junk.pch del $(WINDIR)\_junk.pch - @echo Cleaning $(WINDIR)\vercl.x ... - @if exist $(WINDIR)\vercl.x del $(WINDIR)\vercl.x - @echo Cleaning $(WINDIR)\vercl.i ... - @if exist $(WINDIR)\vercl.i del $(WINDIR)\vercl.i - @echo Cleaning $(WINDIR)\versions.vc ... - @if exist $(WINDIR)\versions.vc del $(WINDIR)\versions.vc + @echo Cleaning $(WIN_DIR)\nmakehlp.obj ... + @if exist $(WIN_DIR)\nmakehlp.obj del $(WIN_DIR)\nmakehlp.obj + @echo Cleaning $(WIN_DIR)\nmakehlp.exe ... + @if exist $(WIN_DIR)\nmakehlp.exe del $(WIN_DIR)\nmakehlp.exe + @echo Cleaning $(WIN_DIR)\_junk.pch ... + @if exist $(WIN_DIR)\_junk.pch del $(WIN_DIR)\_junk.pch + @echo Cleaning $(WIN_DIR)\vercl.x ... + @if exist $(WIN_DIR)\vercl.x del $(WIN_DIR)\vercl.x + @echo Cleaning $(WIN_DIR)\vercl.i ... + @if exist $(WIN_DIR)\vercl.i del $(WIN_DIR)\vercl.i + @echo Cleaning $(WIN_DIR)\versions.vc ... + @if exist $(WIN_DIR)\versions.vc del $(WIN_DIR)\versions.vc realclean: hose -- cgit v0.12 From 3b982165aff1858cc7a0a4ea123cd74d3704f872 Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 12 Sep 2019 19:34:23 +0000 Subject: cmdAH.test (win-only): rewrite test to prefer SystemRoot (readonly) instead of windir to check windows directory is not owned, bug [7de2d722bd] --- tests/cmdAH.test | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/tests/cmdAH.test b/tests/cmdAH.test index b60f658..0f3ca7c 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -1349,8 +1349,12 @@ test cmdAH-25.2.1 {Tcl_FileObjCmd: owned} -constraints unix -setup { test cmdAH-25.3 {Tcl_FileObjCmd: owned} {unix notRoot} { file owned / } 0 -test cmdAH-25.3.1 {Tcl_FileObjCmd: owned} -constraints {win knownMsvcBug} -body { - file owned $env(windir) +test cmdAH-25.3.1 {Tcl_FileObjCmd: owned} -constraints win -body { + if {[info exists env(SystemRoot)]} { + file owned $env(SystemRoot) + } else { + file owned $env(windir) + } } -result 0 test cmdAH-25.4 {Tcl_FileObjCmd: owned} -body { file owned nosuchfile -- cgit v0.12 From 794b9c5949eb0c88fde85361818d0246a9e3235e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 13 Sep 2019 07:55:30 +0000 Subject: Remove unneeded knownMsvcBug testconstraint definition --- tests/cmdAH.test | 1 - win/makefile.vc | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/tests/cmdAH.test b/tests/cmdAH.test index 0f3ca7c..f19e11a 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -30,7 +30,6 @@ testConstraint linkDirectory [expr { ($::tcl_platform(osVersion) >= 5.0 && [lindex [file system [temporaryDirectory]] 1] eq "NTFS") }] -testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] global env set cmdAHwd [pwd] diff --git a/win/makefile.vc b/win/makefile.vc index 04dcbcb..8f74e79 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -480,11 +480,11 @@ $(TCLLIB): $(TCLOBJS) $** << $(_VC_MANIFEST_EMBED_DLL) + $(TCLIMPLIB): $(TCLLIB) !endif # $(STATIC_BUILD) - $(TCLSTUBLIB): $(TCLSTUBOBJS) $(LIBCMD) -nodefaultlib $(TCLSTUBOBJS) -- cgit v0.12 From 98e3a60b678a4788e86ecda69c4e6374ccb9de40 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 13 Sep 2019 09:01:44 +0000 Subject: Add knownMsvcBug restriction to chanio-20.5, because it sometimes hangs in a Travis build. Restucture many test-cases to tcltest 2 syntax. --- tests/chanio.test | 399 ++++++++++++++++++++++++------------------------------ 1 file changed, 178 insertions(+), 221 deletions(-) diff --git a/tests/chanio.test b/tests/chanio.test index a18bbbe..5fae431 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -92,6 +92,11 @@ namespace eval ::tcl::test::io { return $a } + # Wrapper round butt-ugly pipe syntax + proc openpipe {{mode r+} args} { + open "|[list [interpreter] {*}$args]" $mode + } + test chan-io-1.5 {Tcl_WriteChars: CheckChannelErrors} {emptyTest} { # no test, need to cause an async error. } {} @@ -114,80 +119,58 @@ set path(test2) [makeFile {} test2] test chan-io-1.8 {Tcl_WriteChars: WriteChars} { # This test written for SF bug #506297. # - # Executing this test without the fix for the referenced bug - # applied to tcl will cause tcl, more specifically WriteChars, to - # go into an infinite loop. - + # Executing this test without the fix for the referenced bug applied to + # tcl will cause tcl, more specifically WriteChars, to go into an infinite + # loop. set f [open $path(test2) w] chan configure $f -encoding iso2022-jp chan puts -nonewline $f [format %s%c [string repeat " " 4] 12399] chan close $f contents $path(test2) } " \x1b\$B\$O\x1b(B" - test chan-io-1.9 {Tcl_WriteChars: WriteChars} { - # When closing a channel with an encoding that appends - # escape bytes, check for the case where the escape - # bytes overflow the current IO buffer. The bytes - # should be moved into a new buffer. - + # When closing a channel with an encoding that appends escape bytes, check + # for the case where the escape bytes overflow the current IO buffer. The + # bytes should be moved into a new buffer. set data "1234567890 [format %c 12399]" - set sizes [list] - # With default buffer size set f [open $path(test2) w] chan configure $f -encoding iso2022-jp chan puts -nonewline $f $data chan close $f lappend sizes [file size $path(test2)] - - # With buffer size equal to the length - # of the data, the escape bytes would + # With buffer size equal to the length of the data, the escape bytes would # go into the next buffer. - set f [open $path(test2) w] chan configure $f -encoding iso2022-jp -buffersize 16 chan puts -nonewline $f $data chan close $f lappend sizes [file size $path(test2)] - - # With buffer size that is large enough - # to hold 1 byte of escaped data, but - # not all 3. This should not write - # the escape bytes to the first buffer - # and then again to the second buffer. - + # With buffer size that is large enough to hold 1 byte of escaped data, + # but not all 3. This should not write the escape bytes to the first + # buffer and then again to the second buffer. set f [open $path(test2) w] chan configure $f -encoding iso2022-jp -buffersize 17 chan puts -nonewline $f $data chan close $f lappend sizes [file size $path(test2)] - - # With buffer size that can hold 2 out of - # 3 bytes of escaped data. - + # With buffer size that can hold 2 out of 3 bytes of escaped data. set f [open $path(test2) w] chan configure $f -encoding iso2022-jp -buffersize 18 chan puts -nonewline $f $data chan close $f lappend sizes [file size $path(test2)] - - # With buffer size that can hold all the - # data and escape bytes. - + # With buffer size that can hold all the data and escape bytes. set f [open $path(test2) w] chan configure $f -encoding iso2022-jp -buffersize 19 chan puts -nonewline $f $data chan close $f lappend sizes [file size $path(test2)] - - set sizes } {19 19 19 19 19} test chan-io-2.1 {WriteBytes} { # loop until all bytes are written - set f [open $path(test1) w] chan configure $f -encoding binary -buffersize 16 -translation crlf chan puts $f "abcdefghijklmnopqrstuvwxyz" @@ -197,7 +180,6 @@ test chan-io-2.1 {WriteBytes} { test chan-io-2.2 {WriteBytes: savedLF > 0} { # After flushing buffer, there was a \n left over from the last # \n -> \r\n expansion. It gets stuck at beginning of this buffer. - set f [open $path(test1) w] chan configure $f -encoding binary -buffersize 16 -translation crlf chan puts -nonewline $f "123456789012345\n12" @@ -205,18 +187,17 @@ test chan-io-2.2 {WriteBytes: savedLF > 0} { chan close $f lappend x [contents $path(test1)] } [list "123456789012345\r" "123456789012345\r\n12"] -test chan-io-2.3 {WriteBytes: flush on line} { - # Tcl "line" buffering has weird behavior: if current buffer contains - # a \n, entire buffer gets flushed. Logical behavior would be to flush - # only up to the \n. - +test chan-io-2.3 {WriteBytes: flush on line} -body { + # Tcl "line" buffering has weird behavior: if current buffer contains a + # \n, entire buffer gets flushed. Logical behavior would be to flush only + # up to the \n. set f [open $path(test1) w] chan configure $f -encoding binary -buffering line -translation crlf chan puts -nonewline $f "\n12" - set x [contents $path(test1)] + contents $path(test1) +} -cleanup { chan close $f - set x -} "\r\n12" +} -result "\r\n12" test chan-io-2.4 {WriteBytes: reset sawLF after each buffer} { set f [open $path(test1) w] chan configure $f -encoding binary -buffering line -translation lf \ @@ -229,7 +210,6 @@ test chan-io-2.4 {WriteBytes: reset sawLF after each buffer} { test chan-io-3.1 {WriteChars: compatibility with WriteBytes} { # loop until all bytes are written - set f [open $path(test1) w] chan configure $f -encoding ascii -buffersize 16 -translation crlf chan puts $f "abcdefghijklmnopqrstuvwxyz" @@ -239,7 +219,6 @@ test chan-io-3.1 {WriteChars: compatibility with WriteBytes} { test chan-io-3.2 {WriteChars: compatibility with WriteBytes: savedLF > 0} { # After flushing buffer, there was a \n left over from the last # \n -> \r\n expansion. It gets stuck at beginning of this buffer. - set f [open $path(test1) w] chan configure $f -encoding ascii -buffersize 16 -translation crlf chan puts -nonewline $f "123456789012345\n12" @@ -247,21 +226,19 @@ test chan-io-3.2 {WriteChars: compatibility with WriteBytes: savedLF > 0} { chan close $f lappend x [contents $path(test1)] } [list "123456789012345\r" "123456789012345\r\n12"] -test chan-io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} { - # Tcl "line" buffering has weird behavior: if current buffer contains - # a \n, entire buffer gets flushed. Logical behavior would be to flush - # only up to the \n. - +test chan-io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} -body { + # Tcl "line" buffering has weird behavior: if current buffer contains a + # \n, entire buffer gets flushed. Logical behavior would be to flush only + # up to the \n. set f [open $path(test1) w] chan configure $f -encoding ascii -buffering line -translation crlf chan puts -nonewline $f "\n12" - set x [contents $path(test1)] + contents $path(test1) +} -cleanup { chan close $f - set x -} "\r\n12" +} -result "\r\n12" test chan-io-3.4 {WriteChars: loop over stage buffer} { # stage buffer maps to more than can be queued at once. - set f [open $path(test1) w] chan configure $f -encoding jis0208 -buffersize 16 chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" @@ -270,10 +247,9 @@ test chan-io-3.4 {WriteChars: loop over stage buffer} { lappend x [contents $path(test1)] } [list "!)!)!)!)!)!)!)!)" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"] test chan-io-3.5 {WriteChars: saved != 0} { - # Bytes produced by UtfToExternal from end of last channel buffer - # had to be moved to beginning of next channel buffer to preserve - # requested buffersize. - + # Bytes produced by UtfToExternal from end of last channel buffer had to + # be moved to beginning of next channel buffer to preserve requested + # buffersize. set f [open $path(test1) w] chan configure $f -encoding jis0208 -buffersize 17 chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" @@ -282,15 +258,14 @@ test chan-io-3.5 {WriteChars: saved != 0} { lappend x [contents $path(test1)] } [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"] test chan-io-3.6 {WriteChars: (stageRead + dstWrote == 0)} { - # One incomplete UTF-8 character at end of staging buffer. Backup - # in src to the beginning of that UTF-8 character and try again. + # One incomplete UTF-8 character at end of staging buffer. Backup in src + # to the beginning of that UTF-8 character and try again. # # Translate the first 16 bytes, produce 14 bytes of output, 2 left over - # (first two bytes of \uff21 in UTF-8). Given those two bytes try + # (first two bytes of \uff21 in UTF-8). Given those two bytes try # translating them again, find that no bytes are read produced, and break - # to outer loop where those two bytes will have the remaining 4 bytes - # (the last byte of \uff21 plus the all of \uff22) appended. - + # to outer loop where those two bytes will have the remaining 4 bytes (the + # last byte of \uff21 plus the all of \uff22) appended. set f [open $path(test1) w] chan configure $f -encoding shiftjis -buffersize 16 chan puts -nonewline $f "12345678901234\uff21\uff22" @@ -299,12 +274,11 @@ test chan-io-3.6 {WriteChars: (stageRead + dstWrote == 0)} { lappend x [contents $path(test1)] } [list "12345678901234\x82\x60" "12345678901234\x82\x60\x82\x61"] test chan-io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} { - # When translating UTF-8 to external, the produced bytes went past end - # of the channel buffer. This is done purpose -- we then truncate the - # bytes at the end of the partial character to preserve the requested - # blocksize on flush. The truncated bytes are moved to the beginning - # of the next channel buffer. - + # When translating UTF-8 to external, the produced bytes went past end of + # the channel buffer. This is done on purpose - we then truncate the bytes + # at the end of the partial character to preserve the requested blocksize + # on flush. The truncated bytes are moved to the beginning of the next + # channel buffer. set f [open $path(test1) w] chan configure $f -encoding jis0208 -buffersize 17 chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" @@ -324,7 +298,6 @@ test chan-io-3.8 {WriteChars: reset sawLF after each buffer} { test chan-io-4.1 {TranslateOutputEOL: lf} { # search for \n - set f [open $path(test1) w] chan configure $f -buffering line -translation lf chan puts $f "abcde" @@ -334,7 +307,6 @@ test chan-io-4.1 {TranslateOutputEOL: lf} { } [list "abcde\n" "abcde\n"] test chan-io-4.2 {TranslateOutputEOL: cr} { # search for \n, replace with \r - set f [open $path(test1) w] chan configure $f -buffering line -translation cr chan puts $f "abcde" @@ -344,7 +316,6 @@ test chan-io-4.2 {TranslateOutputEOL: cr} { } [list "abcde\r" "abcde\r"] test chan-io-4.3 {TranslateOutputEOL: crlf} { # simple case: search for \n, replace with \r - set f [open $path(test1) w] chan configure $f -buffering line -translation crlf chan puts $f "abcde" @@ -353,10 +324,9 @@ test chan-io-4.3 {TranslateOutputEOL: crlf} { lappend x [contents $path(test1)] } [list "abcde\r\n" "abcde\r\n"] test chan-io-4.4 {TranslateOutputEOL: crlf} { - # keep storing more bytes in output buffer until output buffer is full. - # We have 13 bytes initially that would turn into 18 bytes. Fill - # dest buffer while (dstEnd < dstMax). - + # Keep storing more bytes in output buffer until output buffer is full. We + # have 13 bytes initially that would turn into 18 bytes. Fill dest buffer + # while (dstEnd < dstMax). set f [open $path(test1) w] chan configure $f -translation crlf -buffersize 16 chan puts -nonewline $f "1234567\n\n\n\n\nA" @@ -366,7 +336,6 @@ test chan-io-4.4 {TranslateOutputEOL: crlf} { } [list "1234567\r\n\r\n\r\n\r\n\r" "1234567\r\n\r\n\r\n\r\n\r\nA"] test chan-io-4.5 {TranslateOutputEOL: crlf} { # Check for overflow of the destination buffer - set f [open $path(test1) w] chan configure $f -translation crlf -buffersize 12 chan puts -nonewline $f "12345678901\n456789012345678901234" @@ -415,109 +384,106 @@ test chan-io-5.5 {CheckFlush: none} { lappend x [contents $path(test1)] } [list "1234567890" "1234567890"] -test chan-io-6.1 {Tcl_GetsObj: working} { +test chan-io-6.1 {Tcl_GetsObj: working} -body { set f [open $path(test1) w] chan puts $f "foo\nboo" chan close $f set f [open $path(test1)] - set x [chan gets $f] + chan gets $f +} -cleanup { chan close $f - set x -} {foo} +} -result {foo} test chan-io-6.2 {Tcl_GetsObj: CheckChannelErrors() != 0} emptyTest { # no test, need to cause an async error. } {} -test chan-io-6.3 {Tcl_GetsObj: how many have we used?} { +test chan-io-6.3 {Tcl_GetsObj: how many have we used?} -body { # if (bufPtr != NULL) {oldRemoved = bufPtr->nextRemoved} - set f [open $path(test1) w] chan configure $f -translation crlf chan puts $f "abc\ndefg" chan close $f set f [open $path(test1)] - set x [list [chan tell $f] [chan gets $f line] [chan tell $f] [chan gets $f line] $line] + list [chan tell $f] [chan gets $f line] [chan tell $f] [chan gets $f line] $line +} -cleanup { chan close $f - set x -} {0 3 5 4 defg} -test chan-io-6.4 {Tcl_GetsObj: encoding == NULL} { +} -result {0 3 5 4 defg} +test chan-io-6.4 {Tcl_GetsObj: encoding == NULL} -body { set f [open $path(test1) w] chan configure $f -translation binary chan puts $f "\x81\u1234\0" chan close $f set f [open $path(test1)] chan configure $f -translation binary - set x [list [chan gets $f line] $line] + list [chan gets $f line] $line +} -cleanup { chan close $f - set x -} [list 3 "\x81\x34\x00"] -test chan-io-6.5 {Tcl_GetsObj: encoding != NULL} { +} -result [list 3 "\x81\x34\x00"] +test chan-io-6.5 {Tcl_GetsObj: encoding != NULL} -body { set f [open $path(test1) w] chan configure $f -translation binary chan puts $f "\x88\xea\x92\x9a" chan close $f set f [open $path(test1)] chan configure $f -encoding shiftjis - set x [list [chan gets $f line] $line] + list [chan gets $f line] $line +} -cleanup { chan close $f - set x -} [list 2 "\u4e00\u4e01"] +} -result [list 2 "\u4e00\u4e01"] set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" append a $a append a $a -test chan-io-6.6 {Tcl_GetsObj: loop test} { - # if (dst >= dstEnd) - +test chan-io-6.6 {Tcl_GetsObj: loop test} -body { + # if (dst >= dstEnd) set f [open $path(test1) w] chan puts $f $a chan puts $f hi chan close $f set f [open $path(test1)] - set x [list [chan gets $f line] $line] + list [chan gets $f line] $line +} -cleanup { chan close $f - set x -} [list 256 $a] -test chan-io-6.7 {Tcl_GetsObj: error in input} {stdio openpipe} { +} -result [list 256 $a] +test chan-io-6.7 {Tcl_GetsObj: error in input} -constraints {stdio openpipe} -body { # if (FilterInputBytes(chanPtr, &gs) != 0) - - set f [open "|[list [interpreter] $path(cat)]" w+] + set f [openpipe w+ $path(cat)] chan puts -nonewline $f "hi\nwould" chan flush $f chan gets $f chan configure $f -blocking 0 - set x [chan gets $f line] + chan gets $f line +} -cleanup { chan close $f - set x -} {-1} -test chan-io-6.8 {Tcl_GetsObj: remember if EOF is seen} { +} -result {-1} +test chan-io-6.8 {Tcl_GetsObj: remember if EOF is seen} -body { set f [open $path(test1) w] chan puts $f "abcdef\x1aghijk\nwombat" chan close $f set f [open $path(test1)] chan configure $f -eofchar \x1a - set x [list [chan gets $f line] $line [chan gets $f line] $line] + list [chan gets $f line] $line [chan gets $f line] $line +} -cleanup { chan close $f - set x -} {6 abcdef -1 {}} -test chan-io-6.9 {Tcl_GetsObj: remember if EOF is seen} { +} -result {6 abcdef -1 {}} +test chan-io-6.9 {Tcl_GetsObj: remember if EOF is seen} -body { set f [open $path(test1) w] chan puts $f "abcdefghijk\nwom\u001abat" chan close $f set f [open $path(test1)] chan configure $f -eofchar \x1a - set x [list [chan gets $f line] $line [chan gets $f line] $line] + list [chan gets $f line] $line [chan gets $f line] $line +} -cleanup { chan close $f - set x -} {11 abcdefghijk 3 wom} +} -result {11 abcdefghijk 3 wom} # Comprehensive tests -test chan-io-6.10 {Tcl_GetsObj: lf mode: no chars} { +test chan-io-6.10 {Tcl_GetsObj: lf mode: no chars} -body { set f [open $path(test1) w] chan close $f set f [open $path(test1)] chan configure $f -translation lf - set x [list [chan gets $f line] $line] + list [chan gets $f line] $line +} -cleanup { chan close $f - set x -} {-1 {}} +} -result {-1 {}} test chan-io-6.11 {Tcl_GetsObj: lf mode: lone \n} { set f [open $path(test1) w] chan configure $f -translation lf @@ -1911,31 +1877,33 @@ test chan-io-19.4 {Tcl_CreateChannel, insertion into channel table} {testchannel [list 0 [format "can not find channel named \"%s\"" $f]] } 0 -test chan-io-20.1 {Tcl_CreateChannel: initial settings} { - set a [open $path(test2) w] +test chan-io-20.1 {Tcl_CreateChannel: initial settings} -setup { set old [encoding system] +} -body { + set a [open $path(test2) w] encoding system ascii set f [open $path(test1) w] - set x [chan configure $f -encoding] - chan close $f + chan configure $f -encoding +} -cleanup { encoding system $old - chan close $a - set x -} {ascii} -test chan-io-20.2 {Tcl_CreateChannel: initial settings} {win} { + chan close $f + chan close $a +} -result {ascii} +test chan-io-20.2 {Tcl_CreateChannel: initial settings} -constraints {win} -body { set f [open $path(test1) w+] - set x [list [chan configure $f -eofchar] [chan configure $f -translation]] + list [chan configure $f -eofchar] [chan configure $f -translation] +} -cleanup { chan close $f - set x -} [list [list \x1a ""] {auto crlf}] -test chan-io-20.3 {Tcl_CreateChannel: initial settings} {unix} { +} -result [list [list \x1a ""] {auto crlf}] +test chan-io-20.3 {Tcl_CreateChannel: initial settings} -constraints {unix} -body { set f [open $path(test1) w+] - set x [list [chan configure $f -eofchar] [chan configure $f -translation]] + list [chan configure $f -eofchar] [chan configure $f -translation] +} -cleanup { chan close $f - set x -} {{{} {}} {auto lf}} -set path(stdout) [makeFile {} stdout] -test chan-io-20.5 {Tcl_CreateChannel: install channel in empty slot} {stdio openpipe} { +} -result {{{} {}} {auto lf}} +test chan-io-20.5 {Tcl_CreateChannel: install channel in empty slot} -setup { + set path(stdout) [makeFile {} stdout] +} -constraints {stdio openpipe knownMsvcBug} -body { set f [open $path(script) w] chan puts -nonewline $f { chan close stdout @@ -1946,19 +1914,20 @@ test chan-io-20.5 {Tcl_CreateChannel: install channel in empty slot} {stdio open chan puts stderr [chan configure stdout -buffersize] } chan close $f - set f [open "|[list [interpreter] $path(script)]"] - catch {chan close $f} msg - set msg -} {777} + set f [openpipe r $path(script)] + chan close $f +} -cleanup { + removeFile $path(stdout) +} -returnCodes error -result {777} test chan-io-21.1 {Chan CloseChannelsOnExit} emptyTest { } {} -# Test management of attributes associated with a channel, such as -# its default translation, its name and type, etc. The functions -# tested in this group are Tcl_GetChannelName, -# Tcl_GetChannelType and Tcl_GetChannelFile. Tcl_GetChannelInstanceData -# not tested because files do not use the instance data. +# Test management of attributes associated with a channel, such as its default +# translation, its name and type, etc. The functions tested in this group are +# Tcl_GetChannelName, Tcl_GetChannelType and Tcl_GetChannelFile. +# Tcl_GetChannelInstanceData not tested because files do not use the instance +# data. test chan-io-22.1 {Tcl_GetChannelMode} emptyTest { # Not used anywhere in Tcl. @@ -2722,7 +2691,7 @@ test chan-io-29.32 {Tcl_WriteChars, background flush to slow reader} \ set result ok } } ok -test chan-io-29.33 {Tcl_Flush, implicit flush on exit} {exec} { +test chan-io-29.33 {Tcl_Flush, implicit flush on exit} -setup { set f [open $path(script) w] chan puts $f "set f \[[list open $path(test1) w]]" chan puts $f {chan configure $f -translation lf @@ -2731,13 +2700,14 @@ test chan-io-29.33 {Tcl_Flush, implicit flush on exit} {exec} { chan puts $f strange } chan close $f +} -constraints exec -body { exec [interpreter] $path(script) set f [open $path(test1) r] - set r [chan read $f] + chan read $f +} -cleanup { chan close $f - set r -} "hello\nbye\nstrange\n" -test chan-io-29.34 {Tcl_Chan Close, async flush on chan close, using sockets} {socket tempNotMac fileevent knownMsvcBug} { +} -result "hello\nbye\nstrange\n" +test chan-io-29.34 {Tcl_Chan Close, async flush on chan close, using sockets} -setup { variable c 0 variable x running set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz @@ -2746,6 +2716,7 @@ test chan-io-29.34 {Tcl_Chan Close, async flush on chan close, using sockets} {s chan puts $s $l } } +} -constraints {socket tempNotMac fileevent knownMsvcBug} -body { proc accept {s a p} { variable x chan event $s readable [namespace code [list readit $s]] @@ -2772,7 +2743,7 @@ test chan-io-29.34 {Tcl_Chan Close, async flush on chan close, using sockets} {s chan close $ss vwait [namespace which -variable x] set c -} 2000 +} -result 2000 test chan-io-29.35 {Tcl_Chan Close vs chan event vs multiple interpreters} {socket tempNotMac fileevent} { # On Mac, this test screws up sockets such that subsequent tests using port 2828 # either cause errors or panic(). @@ -6890,10 +6861,11 @@ proc doFcopy {in out {bytes 0} {error {}}} { -command [namespace code [list doFcopy $in $out]]] } } -test chan-io-53.7 {CopyData: Flooding chan copy from pipe} {stdio openpipe fcopy} { +test chan-io-53.7 {CopyData: Flooding chan copy from pipe} -setup { variable fcopyTestDone file delete $path(pipe) catch {unset fcopyTestDone} +} -constraints {stdio openpipe fcopy} -body { set fcopyTestCount 0 set f1 [open $path(pipe) w] chan puts $f1 { @@ -6912,18 +6884,19 @@ test chan-io-53.7 {CopyData: Flooding chan copy from pipe} {stdio openpipe fcopy exit 0 } chan close $f1 - set in [open "|[list [interpreter] $path(pipe) &]" r+] + set in [openpipe r+ $path(pipe) &] set out [open $path(test1) w] doFcopy $in $out variable fcopyTestDone - if ![info exists fcopyTestDone] { + if {![info exists fcopyTestDone]} { vwait [namespace which -variable fcopyTestDone] } - catch {chan close $in} - chan close $out # -1=error 0=script error N=number of bytes expr ($fcopyTestDone == 0) ? $fcopyTestCount : -1 -} {3450} +} -cleanup { + catch {chan close $in} + chan close $out +} -result {3450} test chan-io-53.8 {CopyData: async callback and error handling, Bug 1932639} -setup { # copy progress callback. errors out intentionally proc ::cmd args { @@ -7081,7 +7054,7 @@ test chan-io-53.10 {Bug 1350564, multi-directional fcopy} -setup { global l srv chan configure $sok -translation binary -buffering none lappend l $sok - if {[llength $l]==2} { + if {[llength $l] == 2} { chan close $srv foreach {a b} $l break chan copy $a $b -command [list geof $a] @@ -7133,7 +7106,6 @@ test chan-io-53.10 {Bug 1350564, multi-directional fcopy} -setup { test chan-io-54.1 {Recursive channel events} {socket fileevent} { # This test checks to see if file events are delivered during recursive # event loops when there is buffered data on the channel. - proc accept {s a p} { variable as chan configure $s -translation lf @@ -7152,13 +7124,13 @@ test chan-io-54.1 {Recursive channel events} {socket fileevent} { incr x } set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0] - - # We need to delay on some systems until the creation of the - # server socket completes. - + # We need to delay on some systems until the creation of the server socket + # completes. set done 0 for {set i 0} {$i < 10} {incr i} { - if {![catch {set cs [socket 127.0.0.1 [lindex [chan configure $ss -sockname] 2]]}]} { + if {![catch { + set cs [socket 127.0.0.1 [lindex [chan configure $ss -sockname] 2]] + }]} { set done 1 break } @@ -7184,65 +7156,56 @@ test chan-io-54.1 {Recursive channel events} {socket fileevent} { chan close $cs list $result $x } {{{line 1} 1 2} 2} -test chan-io-54.2 {Testing for busy-wait in recursive channel events} {socket fileevent} { +test chan-io-54.2 {Testing for busy-wait in recursive channel events} -setup { set accept {} set after {} + variable done 0 +} -constraints {socket fileevent} -body { variable s [socket -server [namespace code accept] -myaddr 127.0.0.1 0] proc accept {s a p} { - variable counter - variable accept - - set accept $s - set counter 0 + variable counter 0 + variable accept $s chan configure $s -blocking off -buffering line -translation lf chan event $s readable [namespace code "doit $s"] } proc doit {s} { variable counter variable after - incr counter - set l [chan gets $s] - if {"$l" == ""} { + if {[chan gets $s] eq ""} { chan event $s readable [namespace code "doit1 $s"] - set after [after 1000 [namespace code newline]] + set after [after 1000 [namespace code { + chan puts $writer hello + chan flush $writer + set done 1 + }]] } } proc doit1 {s} { variable counter variable accept - incr counter - set l [chan gets $s] + chan gets $s chan close $s set accept {} } proc producer {} { variable s variable writer - set writer [socket 127.0.0.1 [lindex [chan configure $s -sockname] 2]] chan configure $writer -buffering line chan puts -nonewline $writer hello chan flush $writer } - proc newline {} { - variable done - variable writer - - chan puts $writer hello - chan flush $writer - set done 1 - } producer - variable done vwait [namespace which -variable done] chan close $writer chan close $s after cancel $after - if {$accept != {}} {chan close $accept} set counter -} 1 +} -cleanup { + if {$accept != {}} {chan close $accept} +} -result 1 set path(fooBar) [makeFile {} fooBar] @@ -7292,14 +7255,15 @@ test chan-io-56.1 {ChannelTimerProc} {testchannelevent} { lappend result $y } {2 done} -test chan-io-57.1 {buffered data and file events, gets} {fileevent} { +test chan-io-57.1 {buffered data and file events, gets} -setup { + variable s2 +} -constraints {fileevent} -body { proc accept {sock args} { variable s2 set s2 $sock } set server [socket -server [namespace code accept] -myaddr 127.0.0.1 0] set s [socket 127.0.0.1 [lindex [chan configure $server -sockname] 2]] - variable s2 vwait [namespace which -variable s2] update chan event $s2 readable [namespace code {lappend result readable}] @@ -7310,19 +7274,21 @@ test chan-io-57.1 {buffered data and file events, gets} {fileevent} { vwait [namespace which -variable result] lappend result [chan gets $s2] vwait [namespace which -variable result] + set result +} -cleanup { chan close $s chan close $s2 chan close $server - set result -} {12 readable 34567890 timer} -test chan-io-57.2 {buffered data and file events, read} {fileevent} { +} -result {12 readable 34567890 timer} +test chan-io-57.2 {buffered data and file events, read} -setup { + variable s2 +} -constraints {fileevent} -body { proc accept {sock args} { variable s2 set s2 $sock } set server [socket -server [namespace code accept] -myaddr 127.0.0.1 0] set s [socket 127.0.0.1 [lindex [chan configure $server -sockname] 2]] - variable s2 vwait [namespace which -variable s2] update chan event $s2 readable [namespace code {lappend result readable}] @@ -7333,11 +7299,12 @@ test chan-io-57.2 {buffered data and file events, read} {fileevent} { vwait [namespace which -variable result] lappend result [chan read $s2 9] vwait [namespace which -variable result] + set result +} -cleanup { chan close $s chan close $s2 chan close $server - set result -} {1 readable 234567890 timer} +} -result {1 readable 234567890 timer} test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin openpipe fileevent} { set out [open $path(script) w] @@ -7358,7 +7325,7 @@ test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin op } } chan close $out - set pipe [open "|[list [interpreter] $path(script)]" r] + set pipe [openpipe r $path(script)] chan event $pipe readable [namespace code [list readit $pipe]] variable x "" set result "" @@ -7368,11 +7335,9 @@ test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin op test chan-io-59.1 {Thread reference of channels} {testmainthread testchannel} { # TIP #10 - # More complicated tests (like that the reference changes as a - # channel is moved from thread to thread) can be done only in the - # extension which fully implements the moving of channels between - # threads, i.e. 'Threads'. Or we have to extend [testthread] as well. - + # More complicated tests (like that the reference changes as a channel is + # moved from thread to thread) can be done only in the extension which + # fully implements the moving of channels between threads, i.e. 'Threads'. set f [open $path(longfile) r] set result [testchannel mthread $f] chan close $f @@ -7381,7 +7346,6 @@ test chan-io-59.1 {Thread reference of channels} {testmainthread testchannel} { test chan-io-60.1 {writing illegal utf sequences} {openpipe fileevent} { # This test will hang in older revisions of the core. - set out [open $path(script) w] chan puts $out { chan puts [encoding convertfrom identity \xe2] @@ -7399,12 +7363,11 @@ test chan-io-60.1 {writing illegal utf sequences} {openpipe fileevent} { } } chan close $out - set pipe [open "|[list [interpreter] $path(script)]" r] + set pipe [openpipe r $path(script)] chan event $pipe readable [namespace code [list readit $pipe]] variable x "" set result "" vwait [namespace which -variable x] - # cut of the remainder of the error stack, especially the filename set result [lreplace $result 3 3 [lindex [split [lindex $result 3] \n] 0]] list $x $result @@ -7431,36 +7394,30 @@ test chan-io-61.1 {Reset eof state after changing the eof char} -setup { #chan seek $f 0 start #chan seek $f 0 current #lappend res [chan read $f; chan tell $f] - chan close $f - set res } -cleanup { + chan close $f removeFile eofchar } -result {77 = 23431} - # Test the cutting and splicing of channels, this is incidentially the -# attach/detach facility of package Thread, but __without any -# safeguards__. It can also be used to emulate transfer of channels -# between threads, and is used for that here. +# attach/detach facility of package Thread, but __without any safeguards__. It +# can also be used to emulate transfer of channels between threads, and is +# used for that here. -test chan-io-70.0 {Cutting & Splicing channels} {testchannel} { +test chan-io-70.0 {Cutting & Splicing channels} -setup { set f [makeFile {... dummy ...} cutsplice] + set res {} +} -constraints {testchannel} -body { set c [open $f r] - - set res {} lappend res [catch {chan seek $c 0 start}] testchannel cut $c - lappend res [catch {chan seek $c 0 start}] testchannel splice $c - lappend res [catch {chan seek $c 0 start}] +} -cleanup { chan close $c - removeFile cutsplice - - set res -} {0 1 0} +} -result {0 1 0} # Duplicate of code in "thread.test". Find a better way of doing this @@ -7699,7 +7656,7 @@ test chan-io-73.1 {channel Tcl_Obj SetChannelFromAny} {} { } {1} # ### ### ### ######### ######### ######### - + # cleanup foreach file [list fooBar longfile script output test1 pipe my_script \ test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] { -- cgit v0.12 From 7d5b0dc33c13fa1026a537ab90b201ed1ce43666 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 13 Sep 2019 13:27:05 +0000 Subject: Make test-cases (hopefully) work on Travis, e.g. by adding nonPortable marks to test-cases which are nonPortable in 8.6 as well. --- tests/fCmd.test | 255 ++++++++++++++++++++++++++++------------------------ tests/registry.test | 6 +- 2 files changed, 140 insertions(+), 121 deletions(-) diff --git a/tests/fCmd.test b/tests/fCmd.test index 71bc186..76fecd4 100644 --- a/tests/fCmd.test +++ b/tests/fCmd.test @@ -162,8 +162,8 @@ proc contents {file} { set root [lindex [file split [pwd]] 0] -# A really long file name -# length of long is 1216 chars, which should be greater than any static buffer +# A really long file name. +# Length of long is 1216 chars, which should be greater than any static buffer # or allowable filename. set long "abcdefghihjllmnopqrstuvwxyz01234567890" @@ -172,20 +172,22 @@ append long $long append long $long append long $long append long $long - -test fCmd-1.1 {TclFileRenameCmd} {notRoot} { + +test fCmd-1.1 {TclFileRenameCmd} -constraints {notRoot} -setup { cleanup +} -body { createfile tf1 file rename tf1 tf2 glob tf* -} {tf2} +} -result {tf2} -test fCmd-2.1 {TclFileCopyCmd} {notRoot} { +test fCmd-2.1 {TclFileCopyCmd} -constraints {notRoot} -setup { cleanup +} -body { createfile tf1 file copy tf1 tf2 lsort [glob tf*] -} {tf1 tf2} +} -result {tf1 tf2} test fCmd-3.1 {FileCopyRename: FileForceOption fails} -constraints {notRoot} -body { file rename -xyz @@ -230,27 +232,31 @@ test fCmd-3.9 {FileCopyRename: too many arguments: argc - i > 2} -setup { } -constraints {notRoot} -returnCodes error -body { file copy -force -- tf1 tf2 tf3 } -result {error copying: target "tf3" is not a directory} -test fCmd-3.10 {FileCopyRename: just 2 arguments} {notRoot} { +test fCmd-3.10 {FileCopyRename: just 2 arguments} -constraints notRoot -setup { cleanup +} -body { createfile tf1 tf1 file rename tf1 tf2 contents tf2 -} {tf1} -test fCmd-3.11 {FileCopyRename: just 2 arguments} {notRoot} { +} -result {tf1} +test fCmd-3.11 {FileCopyRename: just 2 arguments} -constraints notRoot -setup { cleanup +} -body { createfile tf1 tf1 file rename -force -force -- tf1 tf2 contents tf2 -} {tf1} -test fCmd-3.12 {FileCopyRename: move each source: 1 source} {notRoot} { +} -result {tf1} +test fCmd-3.12 {FileCopyRename: move each source: 1 source} -setup { cleanup +} -constraints {notRoot} -body { createfile tf1 tf1 file mkdir td1 file rename tf1 td1 contents [file join td1 tf1] -} {tf1} -test fCmd-3.13 {FileCopyRename: move each source: multiple sources} {notRoot} { +} -result {tf1} +test fCmd-3.13 {FileCopyRename: move each source: multiple sources} -setup { cleanup +} -constraints {notRoot} -body { createfile tf1 tf1 createfile tf2 tf2 createfile tf3 tf3 @@ -259,7 +265,7 @@ test fCmd-3.13 {FileCopyRename: move each source: multiple sources} {notRoot} { file rename tf1 tf2 tf3 tf4 td1 list [contents [file join td1 tf1]] [contents [file join td1 tf2]] \ [contents [file join td1 tf3]] [contents [file join td1 tf4]] -} {tf1 tf2 tf3 tf4} +} -result {tf1 tf2 tf3 tf4} test fCmd-3.14 {FileCopyRename: FileBasename fails} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { @@ -284,22 +290,25 @@ test fCmd-3.16 {FileCopyRename: break on first error} -setup { file rename tf1 tf2 tf3 tf4 td1 } -result [subst {error renaming "tf3" to "[file join td1 tf3]": file already exists}] -test fCmd-4.1 {TclFileMakeDirsCmd: make each dir: 1 dir} {notRoot} { +test fCmd-4.1 {TclFileMakeDirsCmd: make each dir: 1 dir} -setup { cleanup +} -constraints {notRoot} -body { file mkdir td1 glob td* -} {td1} -test fCmd-4.2 {TclFileMakeDirsCmd: make each dir: multiple dirs} {notRoot} { +} -result {td1} +test fCmd-4.2 {TclFileMakeDirsCmd: make each dir: multiple dirs} -setup { cleanup +} -constraints {notRoot} -body { file mkdir td1 td2 td3 lsort [glob td*] -} {td1 td2 td3} -test fCmd-4.3 {TclFileMakeDirsCmd: stops on first error} {notRoot} { +} -result {td1 td2 td3} +test fCmd-4.3 {TclFileMakeDirsCmd: stops on first error} -setup { cleanup +} -constraints {notRoot} -body { createfile tf1 catch {file mkdir td1 td2 tf1 td3 td4} glob td1 td2 tf1 td3 td4 -} {td1 td2 tf1} +} -result {td1 td2 tf1} test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName fails} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { @@ -310,36 +319,40 @@ test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\0'} -setu } -constraints {notRoot} -returnCodes error -body { file mkdir "" } -result {can't create directory "": no such file or directory} -test fCmd-4.6 {TclFileMakeDirsCmd: one level deep} {notRoot} { +test fCmd-4.6 {TclFileMakeDirsCmd: one level deep} -setup { cleanup +} -constraints {notRoot} -body { file mkdir td1 glob td1 -} {td1} -test fCmd-4.7 {TclFileMakeDirsCmd: multi levels deep} {notRoot} { +} -result {td1} +test fCmd-4.7 {TclFileMakeDirsCmd: multi levels deep} -setup { cleanup +} -constraints {notRoot} -body { file mkdir [file join td1 td2 td3 td4] glob td1 [file join td1 td2] -} "td1 [file join td1 td2]" -test fCmd-4.8 {TclFileMakeDirsCmd: already exist: lstat(target) == 0} {notRoot} { +} -result "td1 [file join td1 td2]" +test fCmd-4.8 {TclFileMakeDirsCmd: already exist: lstat(target) == 0} -setup { cleanup +} -constraints {notRoot} -body { file mkdir td1 set x [file exists td1] file mkdir td1 list $x [file exists td1] -} {1 1} +} -result {1 1} test fCmd-4.9 {TclFileMakeDirsCmd: exists, not dir} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { createfile tf1 file mkdir tf1 } -result [subst {can't create directory "[file join tf1]": file already exists}] -test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} {notRoot} { +test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} -setup { cleanup +} -constraints {notRoot} -body { file mkdir td1 set x [file exists td1] file mkdir td1 list $x [file exists td1] -} {1 1} +} -result {1 1} test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} -setup { cleanup } -constraints {unix notRoot testchmod} -returnCodes error -body { @@ -367,11 +380,12 @@ test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} -setup { } -returnCodes error -cleanup { file delete -force foo } -result {can't create directory "foo/tf1": permission denied} -test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} {notRoot} { +test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} -setup { cleanup +} -constraints {notRoot} -body { file mkdir tf1 file exists tf1 -} {1} +} -result {1} test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} -constraints {notRoot} -body { file delete -xyz @@ -379,51 +393,57 @@ test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} -constraints {notRoot} - test fCmd-5.2 {TclFileDeleteCmd: not enough args} -constraints {notRoot} -body { file delete -force -force } -returnCodes error -result {wrong # args: should be "file delete ?options? file ?file ...?"} -test fCmd-5.3 {TclFileDeleteCmd: 1 file} {notRoot} { +test fCmd-5.3 {TclFileDeleteCmd: 1 file} -constraints {notRoot} -setup { cleanup +} -body { createfile tf1 createfile tf2 file mkdir td1 file delete tf2 glob tf* td* -} {tf1 td1} -test fCmd-5.4 {TclFileDeleteCmd: multiple files} {notRoot} { +} -result {tf1 td1} +test fCmd-5.4 {TclFileDeleteCmd: multiple files} -constraints notRoot -setup { cleanup +} -body { createfile tf1 createfile tf2 file mkdir td1 set x [list [file exists tf1] [file exists tf2] [file exists td1]] file delete tf1 td1 tf2 lappend x [file exists tf1] [file exists tf2] [file exists tf3] -} {1 1 1 0 0 0} -test fCmd-5.5 {TclFileDeleteCmd: stop at first error} {notRoot unixOrWin} { +} -cleanup {cleanup} -result {1 1 1 0 0 0} +test fCmd-5.5 {TclFileDeleteCmd: stop at first error} -setup { cleanup +} -constraints {notRoot unixOrWin} -body { createfile tf1 createfile tf2 file mkdir td1 catch {file delete tf1 td1 $root tf2} list [file exists tf1] [file exists tf2] [file exists td1] -} {0 1 0} +} -cleanup {cleanup} -result {0 1 0} test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} -constraints {notRoot} -body { file delete ~_totally_bogus_user } -returnCodes error -result {user "_totally_bogus_user" doesn't exist} -test fCmd-5.7 {TclFileDeleteCmd: Tcl_TranslateFileName succeeds} {notRoot} { +test fCmd-5.7 {TclFileDeleteCmd: Tcl_TranslateFileName succeeds} -setup { catch {file delete ~/tf1} +} -constraints {notRoot} -body { createfile ~/tf1 file delete ~/tf1 -} {} -test fCmd-5.8 {TclFileDeleteCmd: file doesn't exist: lstat(name) != 0} {notRoot} { +} -result {} +test fCmd-5.8 {TclFileDeleteCmd: file doesn't exist: lstat(name) != 0} -setup { cleanup +} -constraints {notRoot} -body { set x [file exists tf1] file delete tf1 list $x [file exists tf1] -} {0 0} -test fCmd-5.9 {TclFileDeleteCmd: is directory} {notRoot} { +} -result {0 0} +test fCmd-5.9 {TclFileDeleteCmd: is directory} -constraints {notRoot} -setup { cleanup +} -body { file mkdir td1 file delete td1 file exists td1 -} {0} +} -result {0} test fCmd-5.10 {TclFileDeleteCmd: TclpRemoveDirectory fails} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { @@ -442,14 +462,14 @@ test fCmd-5.11 {TclFileDeleteCmd: TclpRemoveDirectory with cwd inside} -setup { } -cleanup { cd $dir } -result {0 0 {}} -test fCmd-5.12 {TclFileDeleteCmd: TclpRemoveDirectory with bad perms} {unix} { +test fCmd-5.12 {TclFileDeleteCmd: TclpRemoveDirectory with bad perms} -setup { cleanup +} -constraints {unix} -body { file mkdir [file join td1 td2] - #exec chmod u-rwx [file join td1 td2] file attributes [file join td1 td2] -permissions u+rwx set res [list [catch {file delete -force td1} msg]] lappend res [file exists td1] $msg -} {0 0 {}} +} -result {0 0 {}} test fCmd-6.1 {CopyRenameOneFile: bad source} {notRoot emptyTest} { # can't test this, because it's caught by FileCopyRename @@ -462,18 +482,20 @@ test fCmd-6.3 {CopyRenameOneFile: lstat(source) != 0} -setup { } -constraints {notRoot} -returnCodes error -body { file rename tf1 tf2 } -result {error renaming "tf1": no such file or directory} -test fCmd-6.4 {CopyRenameOneFile: lstat(source) == 0} {notRoot} { +test fCmd-6.4 {CopyRenameOneFile: lstat(source) == 0} -setup { cleanup +} -constraints {notRoot} -body { createfile tf1 file rename tf1 tf2 glob tf* -} {tf2} -test fCmd-6.5 {CopyRenameOneFile: lstat(target) != 0} {notRoot} { +} -result {tf2} +test fCmd-6.5 {CopyRenameOneFile: lstat(target) != 0} -setup { cleanup +} -constraints {notRoot} -body { createfile tf1 file rename tf1 tf2 glob tf* -} {tf2} +} -result {tf2} test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} -setup { cleanup } -constraints {unix notRoot testchmod} -body { @@ -490,12 +512,13 @@ test fCmd-6.7 {CopyRenameOneFile: errno != ENOENT} -setup { createfile tf1 file rename tf1 $long } -result [subst {error renaming "tf1" to "$long": file name too long}] -test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} {unix notRoot} { +test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} -setup { cleanup +} -constraints {unix notRoot} -body { createfile tf1 file rename tf1 tf2 glob tf* -} {tf2} +} -result {tf2} test fCmd-6.10 {CopyRenameOneFile: lstat(target) == 0} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { @@ -510,13 +533,14 @@ test fCmd-6.11 {CopyRenameOneFile: force == 0} -setup { createfile tf2 file rename tf1 tf2 } -result {error renaming "tf1" to "tf2": file already exists} -test fCmd-6.12 {CopyRenameOneFile: force != 0} {notRoot} { +test fCmd-6.12 {CopyRenameOneFile: force != 0} -setup { cleanup +} -constraints {notRoot} -body { createfile tf1 createfile tf2 file rename -force tf1 tf2 glob tf* -} {tf2} +} -result {tf2} test fCmd-6.13 {CopyRenameOneFile: source is dir, target is file} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { @@ -564,12 +588,13 @@ test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} -setup { file rename -force td2 td1 } -returnCodes error -match glob -result \ [subst {error renaming "td2" to "[file join td1 td2]": file *}] -test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} {xdev notRoot} { +test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} -setup { cleanup $tmpspace +} -constraints {xdev notRoot} -body { createfile tf1 file rename tf1 $tmpspace glob -nocomplain tf* [file join $tmpspace tf1] -} [file join $tmpspace tf1] +} -result [file join $tmpspace tf1] test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} -constraints {win} -setup { catch {file delete -force c:/tcl8975@ d:/tcl8975@} } -body { @@ -582,23 +607,23 @@ test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} -constraints {win} -setup { file delete -force c:/tcl8975@ catch {file delete -force d:/tcl8975@} } -result {d:/tcl8975@} -test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} \ - {xdev notRoot} { +test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} -setup { cleanup $tmpspace +} -constraints {xdev notRoot} -body { file mkdir td1 file rename td1 $tmpspace glob -nocomplain td* [file join $tmpspace td*] -} [file join $tmpspace td1] -test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} \ - {xdev notRoot} { +} -result [file join $tmpspace td1] +test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} -setup { cleanup $tmpspace +} -constraints {xdev notRoot} -body { createfile tf1 file rename tf1 $tmpspace glob -nocomplain tf* [file join $tmpspace tf*] -} [file join $tmpspace tf1] +} -result [file join $tmpspace tf1] test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} -setup { cleanup $tmpspace -} -constraints {notRoot xdev} -body { +} -constraints {xdev notRoot} -body { file mkdir td1/td2/td3 file attributes td1 -permissions 0000 file rename td1 $tmpspace @@ -696,15 +721,16 @@ test fCmd-7.1 {FileForceOption: none} -constraints {notRoot} -setup { file mkdir [file join tf1 tf2] file delete tf1 } -result {error deleting "tf1": directory not empty} -test fCmd-7.2 {FileForceOption: -force} {notRoot} { +test fCmd-7.2 {FileForceOption: -force} -constraints {notRoot} -setup { cleanup +} -body { file mkdir [file join tf1 tf2] file delete -force tf1 -} {} -test fCmd-7.3 {FileForceOption: --} {notRoot} { +} -result {} +test fCmd-7.3 {FileForceOption: --} -constraints {notRoot} -body { createfile -tf1 file delete -- -tf1 -} {} +} -result {} test fCmd-7.4 {FileForceOption: bad option} -constraints {notRoot} -setup { createfile -tf1 } -body { @@ -731,9 +757,9 @@ test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \ file delete -force td1 } -result "error renaming \"~$user\" to \"td1/[file tail ~$user]\": permission denied" test fCmd-8.2 {FileBasename: basename of ~user: argc == 1 && *path == ~} \ - {unix notRoot} { + -constraints {unix notRoot} -body { string equal [file tail ~$user] ~$user -} 0 +} -result 0 test fCmd-8.3 {file copy and path translation: ensure correct error} -body { file copy ~ [file join this file doesnt exist] } -returnCodes error -result [subst \ @@ -767,7 +793,7 @@ test fCmd-9.3 {file rename: comprehensive: file to new name} -setup { } -result {{tf3 tf4} 1 0} test fCmd-9.4.a {file rename: comprehensive: dir to new name} -setup { cleanup -} -constraints {testchmod win2000orXP} -body { +} -constraints {win2000orXP testchmod} -body { file mkdir td1 td2 testchmod 555 td2 file rename td1 td3 @@ -787,15 +813,16 @@ test fCmd-9.4.b {file rename: comprehensive: dir to new name} -setup { } -cleanup { cleanup } -result {{td3 td4} 1 0} -test fCmd-9.5 {file rename: comprehensive: file to self} {notRoot testchmod} { +test fCmd-9.5 {file rename: comprehensive: file to self} -setup { cleanup +} -constraints {notRoot testchmod} -body { createfile tf1 tf1 createfile tf2 tf2 testchmod 444 tf2 file rename -force tf1 tf1 file rename -force tf2 tf2 list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2] -} {tf1 tf2 1 0} +} -result {tf1 tf2 1 0} test fCmd-9.6.a {file rename: comprehensive: dir to self} -setup { cleanup } -constraints {testchmod win2000orXP} -body { @@ -808,7 +835,7 @@ test fCmd-9.6.a {file rename: comprehensive: dir to self} -setup { } -result {{td1 td2} 1 0} test fCmd-9.6.b {file rename: comprehensive: dir to self} -setup { cleanup -} -constraints {notRoot unix testchmod} -body { +} -constraints {unix notRoot testchmod} -body { file mkdir td1 file mkdir td2 testchmod 555 td2 @@ -843,9 +870,8 @@ test fCmd-9.7 {file rename: comprehensive: file to existing file} -setup { test fCmd-9.8 {file rename: comprehensive: dir to empty dir} -setup { cleanup } -constraints {notRoot testchmod notNetworkFilesystem} -body { - # Under unix, you can rename a read-only directory, but you can't - # move it into another directory. - + # Under unix, you can rename a read-only directory, but you can't move it + # into another directory. file mkdir td1 file mkdir [file join td2 td1] file mkdir tds1 @@ -898,8 +924,9 @@ test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} -setup { list [lsort [glob td*]] $a1 $a2 [file writable tds1] $w2 } -match glob -result \ [subst {{tdd1 tdd2 tds1 tds2} {1 {error renaming "tds1" to "[file join tdd1 tds1]": file *}} {1 {error renaming "tds2" to "[file join tdd2 tds2]": file *}} 1 0}] -test fCmd-9.10 {file rename: comprehensive: file to new name and dir} {notRoot testchmod} { +test fCmd-9.10 {file rename: comprehensive: file to new name and dir} -setup { cleanup +} -constraints {notRoot testchmod} -body { createfile tf1 createfile tf2 file mkdir td1 @@ -908,9 +935,10 @@ test fCmd-9.10 {file rename: comprehensive: file to new name and dir} {notRoot t file rename tf2 [file join td1 tf4] list [catch {glob tf*}] [lsort [glob -directory td1 t*]] \ [file writable [file join td1 tf3]] [file writable [file join td1 tf4]] -} [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}] -test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} {notRoot testchmod} { +} -result [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}] +test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} -setup { cleanup +} -constraints {notRoot testchmod} -body { file mkdir td1 file mkdir td2 file mkdir td3 @@ -926,7 +954,7 @@ test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} {notRoot te } list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \ [file writable [file join td3 td3]] $w4 -} [subst {td3 {[file join td3 td3] [file join td3 td4]} 1 0}] +} -result [subst {td3 {[file join td3 td3] [file join td3 td4]} 1 0}] test fCmd-9.12 {file rename: comprehensive: target exists} -setup { cleanup } -constraints {notRoot testchmod notNetworkFilesystem} -body { @@ -947,18 +975,20 @@ test fCmd-9.13 {file rename: comprehensive: can't overwrite target} -setup { file rename -force td1 td2 } -returnCodes error -match glob -result \ [subst {error renaming "td1" to "[file join td2 td1]": file *}] -test fCmd-9.14 {file rename: comprehensive: dir into self} {notRoot} { +test fCmd-9.14 {file rename: comprehensive: dir into self} -setup { cleanup +} -constraints {notRoot} -body { file mkdir td1 list [glob td*] [list [catch {file rename td1 td1} msg] $msg] -} [subst {td1 {1 {error renaming "td1" to "[file join td1 td1]": trying to rename a volume or move a directory into itself}}}] -test fCmd-9.14.1 {file rename: comprehensive: dir into self} {notRoot} { +} -result [subst {td1 {1 {error renaming "td1" to "[file join td1 td1]": trying to rename a volume or move a directory into itself}}}] +test fCmd-9.14.1 {file rename: comprehensive: dir into self} -setup { cleanup +} -constraints {notRoot} -body { file mkdir td1 file rename td1 td1x file rename td1x td1 set msg "ok" -} {ok} +} -result {ok} test fCmd-9.14.2 {file rename: comprehensive: dir into self} -setup { cleanup set dir [pwd] @@ -1001,18 +1031,19 @@ test fCmd-10.1 {file copy: comprehensive: source doesn't exist} -setup { } -constraints {notRoot} -returnCodes error -body { file copy tf1 tf2 } -result {error copying "tf1": no such file or directory} -test fCmd-10.2 {file copy: comprehensive: file to new name} {notRoot testchmod} { +test fCmd-10.2 {file copy: comprehensive: file to new name} -setup { cleanup +} -constraints {notRoot testchmod} -body { createfile tf1 tf1 createfile tf2 tf2 testchmod 444 tf2 file copy tf1 tf3 file copy tf2 tf4 list [lsort [glob tf*]] [contents tf3] [contents tf4] [file writable tf3] [file writable tf4] -} {{tf1 tf2 tf3 tf4} tf1 tf2 1 0} +} -result {{tf1 tf2 tf3 tf4} tf1 tf2 1 0} test fCmd-10.3 {file copy: comprehensive: dir to new name} -setup { cleanup -} -constraints {notRoot unix testchmod} -body { +} -constraints {unix notRoot testchmod} -body { file mkdir [file join td1 tdx] file mkdir [file join td2 tdy] testchmod 555 td2 @@ -1026,7 +1057,7 @@ test fCmd-10.3 {file copy: comprehensive: dir to new name} -setup { } -result [list {td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 0] test fCmd-10.3.1 {file copy: comprehensive: dir to new name} -setup { cleanup -} -constraints {notRoot win 2000orNewer testchmod} -body { +} -constraints {win notRoot 2000orNewer testchmod} -body { # On Windows with ACLs, copying a directory is defined like this file mkdir [file join td1 tdx] file mkdir [file join td2 tdy] @@ -1113,7 +1144,7 @@ test fCmd-10.7 {file rename: comprehensive: file to new name and dir} -setup { } -result [subst {{tf1 tf2} {[file join td1 tf3] [file join td1 tf4]} 1 0}] test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} -setup { cleanup -} -constraints {notRoot unix testchmod} -body { +} -constraints {unix notRoot testchmod} -body { file mkdir td1 file mkdir td2 file mkdir td3 @@ -1125,7 +1156,7 @@ test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} -setup { } -result [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 0}] test fCmd-10.8.1 {file rename: comprehensive: dir to new name and dir} -setup { cleanup -} -constraints {notRoot win 2000orNewer testchmod} -body { +} -constraints {win notRoot 2000orNewer testchmod} -body { # On Windows with ACLs, copying a directory is defined like this file mkdir td1 file mkdir td2 @@ -1166,7 +1197,7 @@ cleanup # old tests -test fCmd-11.1 {TclFileRenameCmd: -- option } -constraints notRoot -setup { +test fCmd-11.1 {TclFileRenameCmd: -- option} -constraints notRoot -setup { catch {file delete -force -- -tfa1} } -body { set s [createfile -tfa1] @@ -1175,7 +1206,7 @@ test fCmd-11.1 {TclFileRenameCmd: -- option } -constraints notRoot -setup { } -cleanup { file delete tfa2 } -result {1 0} -test fCmd-11.2 {TclFileRenameCmd: bad option } -constraints notRoot -setup { +test fCmd-11.2 {TclFileRenameCmd: bad option} -constraints notRoot -setup { catch {file delete -force -- tfa1} } -body { set s [createfile tfa1] @@ -1184,9 +1215,9 @@ test fCmd-11.2 {TclFileRenameCmd: bad option } -constraints notRoot -setup { } -cleanup { file delete tfa1 } -result {1 1 0} -test fCmd-11.3 {TclFileRenameCmd: bad \# args} { - catch {file rename -- } -} {1} +test fCmd-11.3 {TclFileRenameCmd: bad \# args} -returnCodes error -body { + file rename -- +} -match glob -result * test fCmd-11.4 {TclFileRenameCmd: target filename translation failing} -setup { set temp $::env(HOME) } -constraints notRoot -body { @@ -1369,9 +1400,9 @@ test fCmd-13.3 {TclCopyFilesCmd: bad option} -constraints {notRoot} -setup { } -cleanup { file delete tfa1 } -result {1 1 0} -test fCmd-13.4 {TclCopyFilesCmd: bad \# args} {notRoot} { - catch {file copy -- } -} {1} +test fCmd-13.4 {TclCopyFilesCmd: bad \# args} -constraints {notRoot} -body { + file copy -- +} -returnCodes error -match glob -result * test fCmd-13.5 {TclCopyFilesCmd: target filename translation failing} -setup { set temp $::env(HOME) } -body { @@ -1404,8 +1435,8 @@ test fCmd-13.7 {TclCopyFilesCmd: single file into directory} -setup { test fCmd-13.8 {TclCopyFilesCmd: multiple files into directory} -setup { catch {file delete -force -- tfa1 tfa2 tfad} } -constraints {notRoot} -body { - set s1 [createfile tfa1 ] - set s2 [createfile tfa2 ] + set s1 [createfile tfa1] + set s2 [createfile tfa2] file mkdir tfad file copy tfa1 tfa2 tfad list [checkcontent tfad/tfa1 $s1] [checkcontent tfad/tfa2 $s2] \ @@ -1457,7 +1488,7 @@ test fCmd-14.3 {copyfile: stat failing on source} -setup { test fCmd-14.4 {copyfile: error copying file to directory} -setup { catch {file delete -force -- tfa tfad} } -constraints {notRoot} -body { - set s1 [createfile tfa ] + set s1 [createfile tfa] file mkdir tfad file mkdir tfad/tfa list [catch {file copy tfa tfad}] [checkcontent tfa $s1] \ @@ -1519,10 +1550,9 @@ test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} -setup { set ::env(HOME) $temp } -result {1} # -# Can Tcl_SplitPath return argc == 0? If so them we need a -# test for that code. +# Can Tcl_SplitPath return argc == 0? If so them we need a test for that code. # -test fCmd-15.2 {TclMakeDirsCmd - one directory } -setup { +test fCmd-15.2 {TclMakeDirsCmd - one directory} -setup { catch {file delete -force -- tfa} } -constraints {notRoot} -body { file mkdir tfa @@ -1700,7 +1730,6 @@ test fCmd-17.3 {mkdir several levels deep - absolute} -setup { # # Functionality tests for TclFileRenameCmd() # - test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} \ -setup { catch {file delete -force -- tfad} @@ -1708,7 +1737,7 @@ test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} \ } -constraints {notRoot} -body { file mkdir tfad/dir cd tfad/dir - set s [createfile foo ] + set s [createfile foo] file rename foo bar file rename bar ./foo file rename ./foo bar @@ -1853,7 +1882,6 @@ test fCmd-18.15 {TclFileRenameCmd : rename a file to a symlink dir} -setup { file mkdir tfa1 set s [createfile tfa2] file link -symbolic tfalink tfa1 - file rename tfa2 tfalink checkcontent tfa1/tfa2 $s } -cleanup { @@ -1905,12 +1933,10 @@ test fCmd-19.3 {recursive remove} -constraints {notRoot} -setup { # TclUnixDeleteFile and TraversalDelete are covered by tests from the # TclDeleteFilesCmd suite # -# # # Coverage tests for TraverseUnixTree(), called from TclDeleteFilesCmd # - test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory } -setup { catch {file delete -force -- tfa} } -constraints {unix notRoot} -body { @@ -2085,7 +2111,6 @@ test fCmd-22.1 {TclpRenameFile: rename and overwrite in a single dir} -setup { } -constraints {notRoot} -body { set s [createfile tfa1] set s2 [createfile tfa2 q] - set result [catch {file rename tfa1 tfa2}] file rename -force tfa1 tfa2 lappend result [checkcontent tfa2 $s] @@ -2127,7 +2152,6 @@ test fCmd-22.5 {TclMacCopyFile: copy and overwrite in a single dir} -setup { } -constraints {notRoot} -body { set s [createfile tfa1] set s2 [createfile tfa2 q] - set result [catch {file copy tfa1 tfa2}] file copy -force tfa1 tfa2 lappend result [checkcontent tfa2 $s] [checkcontent tfa1 $s] @@ -2144,12 +2168,10 @@ test fCmd-22.5 {TclMacCopyFile: copy and overwrite in a single dir} -setup { # TclMacRmdir # Error cases are not covered. # - test fCmd-23.1 {TclMacRmdir: trying to remove a nonempty directory} -setup { catch {file delete -force -- tfad} } -constraints {notRoot} -body { file mkdir [file join tfad dir] - list [catch {file delete tfad}] [file delete -force tfad] } -cleanup { catch {file delete -force tfad} @@ -2207,14 +2229,12 @@ test fCmd-25.3 {TclMacCopyDirectory: copying dirs between different dirs} -setup # # Functionality tests for TclDeleteFilesCmd # - test fCmd-26.1 {TclDeleteFilesCmd: delete symlink} -setup { catch {file delete -force -- tfad1 tfad2} } -constraints {unix notRoot} -body { file mkdir tfad1 file link -symbolic tfalink tfad1 file delete tfalink - list [file isdir tfad1] [file exists tfalink] } -cleanup { file delete tfad1 @@ -2227,7 +2247,6 @@ test fCmd-26.2 {TclDeleteFilesCmd: delete dir with symlink} -setup { file mkdir tfad2 file link -symbolic [file join tfad2 link] [file join .. tfad1] file delete -force tfad2 - list [file isdir tfad1] [file exists tfad2] } -cleanup { file delete tfad1 @@ -2239,10 +2258,10 @@ test fCmd-26.3 {TclDeleteFilesCmd: delete dangling symlink} -setup { file link -symbolic tfad2 tfad1 file delete tfad1 file delete tfad2 - list [file exists tfad1] [file exists tfad2] } -result {0 0} +# There is no fCmd-27.1 test fCmd-27.2 {TclFileAttrsCmd - Tcl_TranslateFileName fails} -setup { set platform [testgetplatform] } -constraints {testsetplatform} -body { @@ -2402,7 +2421,7 @@ test fCmd-28.12 {file link: cd into a link} -setup { cd .. set up [pwd] cd $orig - # now '$up' should be either $orig or [file dirname abc.dir], depending on + # Now '$up' should be either $orig or [file dirname abc.dir], depending on # whether 'cd' actually moves to the destination of a link, or simply # treats the link as a directory. (On windows the former, on unix the # latter, I believe) diff --git a/tests/registry.test b/tests/registry.test index 9691b3e..79c6fba 100644 --- a/tests/registry.test +++ b/tests/registry.test @@ -242,7 +242,7 @@ test registry-4.2 {GetKeyNames} {win reg} { registry delete HKEY_CURRENT_USER\\TclFoobar set result } {baz} -test registry-4.3 {GetKeyNames: remote key} {win reg english} { +test registry-4.3 {GetKeyNames: remote key} {win reg nonPortable english} { set hostname [info hostname] registry set \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar\\baz set result [registry keys \\\\gaspode\\HKEY_CURRENT_USER\\TclFoobar] @@ -571,7 +571,7 @@ test registry-7.7 {GetValueNames: names with spaces} -constraints {win reg} -set registry delete HKEY_CURRENT_USER\\TclFoobar } -result {{baz bar} blat} -test registry-8.1 {OpenSubKey} -constraints {win reg english} \ +test registry-8.1 {OpenSubKey} -constraints {win reg nonPortable english} \ -body { # This test will only succeed if the current user does not have # registry access on the specified machine. @@ -657,7 +657,7 @@ test registry-11.2 {SetValue: modification} -constraints {win reg} \ set result [registry get HKEY_CURRENT_USER\\TclFoobar\\baz blat] } -result {frob} test registry-11.3 {SetValue: failure} \ - -constraints {win reg english} \ + -constraints {win reg nonPortable english} \ -body { # This test will only succeed if the current user does not have # registry access on the specified machine. -- cgit v0.12 From e10b32c27a1f48c45ea90e6af530c75fa3fff7a2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 15 Sep 2019 00:01:34 +0000 Subject: try xcode 10.3 --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index a52005f..8defb6e 100644 --- a/.travis.yml +++ b/.travis.yml @@ -113,7 +113,7 @@ matrix: - make test styles=develop TESTFLAGS="-verbose sbtel" - name: "macOS/Xcode 10/Shared" os: osx - osx_image: xcode10.2 + osx_image: xcode10.3 env: - BUILD_DIR=macosx install: [] -- cgit v0.12 From 19eb51a4cbc12b6d10a2ff7c488ae0471bc30503 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 16 Sep 2019 12:47:19 +0000 Subject: Fix Utf16ToUtfProc() (from TIP #548): If last code-point is higher surrogate, make sure that actual conversion is delayed until the next round, assuring proper merging of two surrogates into a single UTF-8 character. --- generic/tclEncoding.c | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 9896f85..0ec0649 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -2485,10 +2485,16 @@ Utf16ToUtfProc( charLimit = *dstCharsPtr; } result = TCL_OK; - if ((srcLen % sizeof(unsigned short)) != 0) { + + /* check alignment with utf-16 (2 == sizeof(UTF-16)) */ + if ((srcLen % 2) != 0) { + result = TCL_CONVERT_MULTIBYTE; + srcLen--; + } + /* If last code point is a high surrogate, we cannot handle that yet */ + if ((srcLen >= 2) && ((src[srcLen - (clientData?1:2)] & 0xFC) == 0xD8)) { result = TCL_CONVERT_MULTIBYTE; - srcLen /= sizeof(unsigned short); - srcLen *= sizeof(unsigned short); + srcLen-= 2; } srcStart = src; -- cgit v0.12 From 906d03c8cb9426745e6b963a807df235647bb8cd Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 16 Sep 2019 16:33:30 +0000 Subject: execute.test: fix tests (if test started using -singleproc 1) --- tests/execute.test | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/tests/execute.test b/tests/execute.test index 72d79fd..468901d 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -1054,7 +1054,7 @@ test execute-8.7 {Compile epoch bump in global level (bug [fa6bf38d07]), excepti test execute-9.1 {Interp result resetting [Bug 1522803]} { set c 0 catch { - catch {set foo} + catch {error foo} expr {1/$c} } if {[string match *foo* $::errorInfo]} { @@ -1089,6 +1089,7 @@ test execute-10.3 {Bug 3072640} -setup { proc t {args} { incr ::foo } + set ::foo 0 trace add execution ::generate enterstep ::t } -body { coroutine coro generate 5 -- cgit v0.12 From caa904131ac249bfd2991302520766b895bcf9a7 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 16 Sep 2019 21:18:21 +0000 Subject: Bugfix in Tcl_UtfPrev/Tcl_UtfNext: When handling 4-byte UTF-8 byte sequences, those should be able to move back/forward 4 bytes if TCL_UTF_MAX <= 4. Update comment accordingly. Bugfix in Tcl_UtfFindFirst/Tcl_UtfFindLast: Those functions should be able to find both the high surrogate (if asked for) as also the full character (combination of both surrogates) --- generic/tclUtf.c | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 0a275d7..9c2ef03 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -275,7 +275,7 @@ Tcl_UniCharToUtfDString( * Tcl_UtfCharComplete() before calling this routine to ensure that * enough bytes remain in the string. * - * If TCL_UTF_MAX == 4, special handling of Surrogate pairs is done: + * If TCL_UTF_MAX <= 4, special handling of Surrogate pairs is done: * For any UTF-8 string containing a character outside of the BMP, the * first call to this function will fill *chPtr with the high surrogate * and generate a return value of 0. Calling Tcl_UtfToUniChar again @@ -584,8 +584,8 @@ Tcl_UtfFindFirst( while (1) { len = TclUtfToUniChar(src, &find); fullchar = find; -#if TCL_UTF_MAX == 4 - if ((ch >= 0xD800) && (len < 3)) { +#if TCL_UTF_MAX <= 4 + if ((fullchar != ch) && (find >= 0xD800) && (len < 3)) { len += TclUtfToUniChar(src + len, &find); fullchar = (((fullchar & 0x3ff) << 10) | (find & 0x3ff)) + 0x10000; } @@ -632,8 +632,8 @@ Tcl_UtfFindLast( while (1) { len = TclUtfToUniChar(src, &find); fullchar = find; -#if TCL_UTF_MAX == 4 - if ((ch >= 0xD800) && (len < 3)) { +#if TCL_UTF_MAX <= 4 + if ((fullchar != ch) && (find >= 0xD800) && (len < 3)) { len += TclUtfToUniChar(src + len, &find); fullchar = (((fullchar & 0x3ff) << 10) | (find & 0x3ff)) + 0x10000; } @@ -675,7 +675,7 @@ Tcl_UtfNext( Tcl_UniChar ch = 0; int len = TclUtfToUniChar(src, &ch); -#if TCL_UTF_MAX == 4 +#if TCL_UTF_MAX <= 4 if ((ch >= 0xD800) && (len < 3)) { len += TclUtfToUniChar(src + len, &ch); } @@ -714,7 +714,7 @@ Tcl_UtfPrev( int i, byte; look = --src; - for (i = 0; i < TCL_UTF_MAX; i++) { + for (i = 0; i < 4; i++) { if (look < start) { if (src < start) { src = start; -- cgit v0.12 From 898b17c6b48b875d48628bd8f9ca74b77dd24132 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 17 Sep 2019 07:02:17 +0000 Subject: Move testgetencpath/testsetencpath test commands from UNIX-specific to general. Rewrite a few other commands (like "memory") to use the Tcl_Obj interface. --- generic/tclCkalloc.c | 118 ++++++++++----------- generic/tclTest.c | 76 ++++++++++++++ unix/tclUnixTest.c | 292 ++++++++++++++------------------------------------- 3 files changed, 214 insertions(+), 272 deletions(-) diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index d7604fa..8746241 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -131,10 +131,12 @@ static int ckallocInit = 0; * Prototypes for procedures defined in this file: */ -static int CheckmemCmd(ClientData clientData, Tcl_Interp *interp, - int argc, const char *argv[]); -static int MemoryCmd(ClientData clientData, Tcl_Interp *interp, - int argc, const char *argv[]); +static int CheckmemCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +static int MemoryCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); static void ValidateMemory(struct mem_header *memHeaderP, const char *file, int line, int nukeGuards); @@ -811,8 +813,8 @@ static int MemoryCmd( ClientData clientData, Tcl_Interp *interp, - int argc, - const char *argv[]) + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Obj values of arguments. */ { const char *fileName; FILE *fileP; @@ -820,20 +822,17 @@ MemoryCmd( int result; size_t len; - if (argc < 2) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "wrong # args: should be \"%s option [args..]\"", argv[0])); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option [args..]"); return TCL_ERROR; } - if (strcmp(argv[1], "active") == 0 || strcmp(argv[1], "display") == 0) { - if (argc != 3) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "wrong # args: should be \"%s %s file\"", - argv[0], argv[1])); + if (strcmp(TclGetString(objv[1]), "active") == 0 || strcmp(TclGetString(objv[1]), "display") == 0) { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "file"); return TCL_ERROR; } - fileName = Tcl_TranslateFileName(interp, argv[2], &buffer); + fileName = Tcl_TranslateFileName(interp, TclGetString(objv[2]), &buffer); if (fileName == NULL) { return TCL_ERROR; } @@ -841,23 +840,23 @@ MemoryCmd( Tcl_DStringFree(&buffer); if (result != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("error accessing %s: %s", - argv[2], Tcl_PosixError(interp))); + TclGetString(objv[2]), Tcl_PosixError(interp))); return TCL_ERROR; } return TCL_OK; } - if (strcmp(argv[1],"break_on_malloc") == 0) { + if (strcmp(TclGetString(objv[1]),"break_on_malloc") == 0) { int value; - if (argc != 3) { + if (objc != 3) { goto argError; } - if (Tcl_GetInt(interp, argv[2], &value) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[2], &value) != TCL_OK) { return TCL_ERROR; } break_on_malloc = (unsigned int) value; return TCL_OK; } - if (strcmp(argv[1],"info") == 0) { + if (strcmp(TclGetString(objv[1]),"info") == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%-25s %10u\n%-25s %10u\n%-25s %10u\n%-25s %10" TCL_Z_MODIFIER"u\n%-25s %10u\n%-25s %10" TCL_Z_MODIFIER "u\n", "total mallocs", total_mallocs, "total frees", total_frees, @@ -867,20 +866,19 @@ MemoryCmd( "maximum bytes allocated", maximum_bytes_malloced)); return TCL_OK; } - if (strcmp(argv[1], "init") == 0) { - if (argc != 3) { + if (strcmp(TclGetString(objv[1]), "init") == 0) { + if (objc != 3) { goto bad_suboption; } - init_malloced_bodies = (strcmp(argv[2],"on") == 0); + init_malloced_bodies = (strcmp(TclGetString(objv[2]),"on") == 0); return TCL_OK; } - if (strcmp(argv[1], "objs") == 0) { - if (argc != 3) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "wrong # args: should be \"%s objs file\"", argv[0])); + if (strcmp(TclGetString(objv[1]), "objs") == 0) { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "file"); return TCL_ERROR; } - fileName = Tcl_TranslateFileName(interp, argv[2], &buffer); + fileName = Tcl_TranslateFileName(interp, TclGetString(objv[2]), &buffer); if (fileName == NULL) { return TCL_ERROR; } @@ -896,13 +894,12 @@ MemoryCmd( Tcl_DStringFree(&buffer); return TCL_OK; } - if (strcmp(argv[1],"onexit") == 0) { - if (argc != 3) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "wrong # args: should be \"%s onexit file\"", argv[0])); + if (strcmp(TclGetString(objv[1]),"onexit") == 0) { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "file"); return TCL_ERROR; } - fileName = Tcl_TranslateFileName(interp, argv[2], &buffer); + fileName = Tcl_TranslateFileName(interp, TclGetString(objv[2]), &buffer); if (fileName == NULL) { return TCL_ERROR; } @@ -911,62 +908,59 @@ MemoryCmd( Tcl_DStringFree(&buffer); return TCL_OK; } - if (strcmp(argv[1],"tag") == 0) { - if (argc != 3) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "wrong # args: should be \"%s tag string\"", argv[0])); + if (strcmp(TclGetString(objv[1]),"tag") == 0) { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "file"); return TCL_ERROR; } if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) { TclpFree((char *) curTagPtr); } - len = strlen(argv[2]); + len = strlen(TclGetString(objv[2])); curTagPtr = (MemTag *) TclpAlloc(TAG_SIZE(len)); curTagPtr->refCount = 0; - memcpy(curTagPtr->string, argv[2], len + 1); + memcpy(curTagPtr->string, TclGetString(objv[2]), len + 1); return TCL_OK; } - if (strcmp(argv[1],"trace") == 0) { - if (argc != 3) { + if (strcmp(TclGetString(objv[1]),"trace") == 0) { + if (objc != 3) { goto bad_suboption; } - alloc_tracing = (strcmp(argv[2],"on") == 0); + alloc_tracing = (strcmp(TclGetString(objv[2]),"on") == 0); return TCL_OK; } - if (strcmp(argv[1],"trace_on_at_malloc") == 0) { + if (strcmp(TclGetString(objv[1]),"trace_on_at_malloc") == 0) { int value; - if (argc != 3) { + if (objc != 3) { goto argError; } - if (Tcl_GetInt(interp, argv[2], &value) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[2], &value) != TCL_OK) { return TCL_ERROR; } trace_on_at_malloc = value; return TCL_OK; } - if (strcmp(argv[1],"validate") == 0) { - if (argc != 3) { + if (strcmp(TclGetString(objv[1]),"validate") == 0) { + if (objc != 3) { goto bad_suboption; } - validate_memory = (strcmp(argv[2],"on") == 0); + validate_memory = (strcmp(TclGetString(objv[2]),"on") == 0); return TCL_OK; } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad option \"%s\": should be active, break_on_malloc, info, " "init, objs, onexit, tag, trace, trace_on_at_malloc, or validate", - argv[1])); + TclGetString(objv[1]))); return TCL_ERROR; argError: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "wrong # args: should be \"%s %s count\"", argv[0], argv[1])); + Tcl_WrongNumArgs(interp, 2, objv, "count"); return TCL_ERROR; bad_suboption: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "wrong # args: should be \"%s %s on|off\"", argv[0], argv[1])); + Tcl_WrongNumArgs(interp, 2, objv, "on|off"); return TCL_ERROR; } @@ -987,21 +981,23 @@ MemoryCmd( * *---------------------------------------------------------------------- */ +static int CheckmemCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); static int CheckmemCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Interpreter for evaluation. */ - int argc, /* Number of arguments. */ - const char *argv[]) /* String values of arguments. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Obj values of arguments. */ { - if (argc != 2) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "wrong # args: should be \"%s fileName\"", argv[0])); + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "fileName"); return TCL_ERROR; } tclMemDumpFileName = dumpFile; - strcpy(tclMemDumpFileName, argv[1]); + strcpy(tclMemDumpFileName, TclGetString(objv[1])); return TCL_OK; } @@ -1027,8 +1023,8 @@ Tcl_InitMemory( * added */ { TclInitDbCkalloc(); - Tcl_CreateCommand(interp, "memory", MemoryCmd, NULL, NULL); - Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "memory", MemoryCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "checkmem", CheckmemCmd, NULL, NULL); } diff --git a/generic/tclTest.c b/generic/tclTest.c index bfaaf56..61c88ba 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -387,6 +387,12 @@ static int TestSimpleFilesystemObjCmd( Tcl_Obj *const objv[]); static void TestReport(const char *cmd, Tcl_Obj *arg1, Tcl_Obj *arg2); +static int TestgetencpathObjCmd(void *dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +static int TestsetencpathObjCmd(void *dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); static Tcl_Obj * TestReportGetNativePath(Tcl_Obj *pathPtr); static Tcl_FSStatProc TestReportStat; static Tcl_FSAccessProc TestReportAccess; @@ -731,6 +737,10 @@ Tcltest_Init( NULL, NULL); Tcl_CreateObjCommand(interp, "testinterpresolver", TestInterpResolverCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testgetencpath", TestgetencpathObjCmd, + NULL, NULL); + Tcl_CreateObjCommand(interp, "testsetencpath", TestsetencpathObjCmd, + NULL, NULL); if (TclObjTest_Init(interp) != TCL_OK) { return TCL_ERROR; @@ -7541,6 +7551,72 @@ TestconcatobjCmd( /* *---------------------------------------------------------------------- * + * TestgetencpathObjCmd -- + * + * This function implements the "testgetencpath" command. It is used to + * test Tcl_GetEncodingSearchPath(). + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestgetencpathObjCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const *objv) /* Argument strings. */ +{ + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, ""); + return TCL_ERROR; + } + + Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath()); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TestsetencpathCmd -- + * + * This function implements the "testsetencpath" command. It is used to + * test Tcl_SetDefaultEncodingDir(). + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestsetencpathObjCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const *objv) /* Argument strings. */ +{ + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "defaultDir"); + return TCL_ERROR; + } + + Tcl_SetEncodingSearchPath(objv[1]); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * TestparseargsCmd -- * * This procedure implements the "testparseargs" command. It is used to diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index e59a0e3..75dccfa 100644 --- a/unix/tclUnixTest.c +++ b/unix/tclUnixTest.c @@ -62,16 +62,13 @@ static const char *gotsig = "0"; * Forward declarations of functions defined later in this file: */ -static Tcl_CmdProc TestalarmCmd; +static Tcl_ObjCmdProc TestalarmCmd; static Tcl_ObjCmdProc TestchmodCmd; -static Tcl_CmdProc TestfilehandlerCmd; -static Tcl_CmdProc TestfilewaitCmd; -static Tcl_CmdProc TestfindexecutableCmd; -static Tcl_ObjCmdProc TestforkObjCmd; -static Tcl_ObjCmdProc TestgetencpathObjCmd; -static Tcl_CmdProc TestgetopenfileCmd; -static Tcl_CmdProc TestgotsigCmd; -static Tcl_ObjCmdProc TestsetencpathObjCmd; +static Tcl_ObjCmdProc TestfilehandlerCmd; +static Tcl_ObjCmdProc TestfilewaitCmd; +static Tcl_ObjCmdProc TestfindexecutableCmd; +static Tcl_ObjCmdProc TestforkCmd; +static Tcl_ObjCmdProc TestgotsigCmd; static Tcl_FileProc TestFileHandlerProc; static void AlarmHandler(int signum); @@ -98,23 +95,17 @@ TclplatformtestInit( { Tcl_CreateObjCommand(interp, "testchmod", TestchmodCmd, NULL, NULL); - Tcl_CreateCommand(interp, "testfilehandler", TestfilehandlerCmd, + Tcl_CreateObjCommand(interp, "testfilehandler", TestfilehandlerCmd, NULL, NULL); - Tcl_CreateCommand(interp, "testfilewait", TestfilewaitCmd, + Tcl_CreateObjCommand(interp, "testfilewait", TestfilewaitCmd, NULL, NULL); - Tcl_CreateCommand(interp, "testfindexecutable", TestfindexecutableCmd, + Tcl_CreateObjCommand(interp, "testfindexecutable", TestfindexecutableCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testfork", TestforkObjCmd, + Tcl_CreateObjCommand(interp, "testfork", TestforkCmd, NULL, NULL); - Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd, + Tcl_CreateObjCommand(interp, "testalarm", TestalarmCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testgetencpath", TestgetencpathObjCmd, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testsetencpath", TestsetencpathObjCmd, - NULL, NULL); - Tcl_CreateCommand(interp, "testalarm", TestalarmCmd, - NULL, NULL); - Tcl_CreateCommand(interp, "testgotsig", TestgotsigCmd, + Tcl_CreateObjCommand(interp, "testgotsig", TestgotsigCmd, NULL, NULL); return TCL_OK; } @@ -140,8 +131,8 @@ static int TestfilehandlerCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const *objv) /* Argument strings. */ { Pipe *pipePtr; int i, mask, timeout; @@ -161,24 +152,23 @@ TestfilehandlerCmd( initialized = 1; } - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - " option ... \"", NULL); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ..."); return TCL_ERROR; } pipePtr = NULL; - if (argc >= 3) { - if (Tcl_GetInt(interp, argv[2], &i) != TCL_OK) { + if (objc >= 3) { + if (Tcl_GetIntFromObj(interp, objv[2], &i) != TCL_OK) { return TCL_ERROR; } if (i >= MAX_PIPES) { - Tcl_AppendResult(interp, "bad index ", argv[2], NULL); + Tcl_AppendResult(interp, "bad index ", objv[2], NULL); return TCL_ERROR; } pipePtr = &testPipes[i]; } - if (strcmp(argv[1], "close") == 0) { + if (strcmp(Tcl_GetString(objv[1]), "close") == 0) { for (i = 0; i < MAX_PIPES; i++) { if (testPipes[i].readFile != NULL) { TclpCloseFile(testPipes[i].readFile); @@ -187,27 +177,24 @@ TestfilehandlerCmd( testPipes[i].writeFile = NULL; } } - } else if (strcmp(argv[1], "clear") == 0) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " clear index\"", NULL); + } else if (strcmp(Tcl_GetString(objv[1]), "clear") == 0) { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "index"); return TCL_ERROR; } pipePtr->readCount = pipePtr->writeCount = 0; - } else if (strcmp(argv[1], "counts") == 0) { + } else if (strcmp(Tcl_GetString(objv[1]), "counts") == 0) { char buf[TCL_INTEGER_SPACE * 2]; - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " counts index\"", NULL); + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "index"); return TCL_ERROR; } sprintf(buf, "%d %d", pipePtr->readCount, pipePtr->writeCount); Tcl_AppendResult(interp, buf, NULL); - } else if (strcmp(argv[1], "create") == 0) { - if (argc != 5) { - Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " create index readMode writeMode\"", NULL); + } else if (strcmp(Tcl_GetString(objv[1]), "create") == 0) { + if (objc != 5) { + Tcl_WrongNumArgs(interp, 2, objv, "index readMode writeMode"); return TCL_ERROR; } if (pipePtr->readFile == NULL) { @@ -228,83 +215,79 @@ TestfilehandlerCmd( pipePtr->readCount = 0; pipePtr->writeCount = 0; - if (strcmp(argv[3], "readable") == 0) { + if (strcmp(Tcl_GetString(objv[3]), "readable") == 0) { Tcl_CreateFileHandler(GetFd(pipePtr->readFile), TCL_READABLE, TestFileHandlerProc, pipePtr); - } else if (strcmp(argv[3], "off") == 0) { + } else if (strcmp(Tcl_GetString(objv[3]), "off") == 0) { Tcl_DeleteFileHandler(GetFd(pipePtr->readFile)); - } else if (strcmp(argv[3], "disabled") == 0) { + } else if (strcmp(Tcl_GetString(objv[3]), "disabled") == 0) { Tcl_CreateFileHandler(GetFd(pipePtr->readFile), 0, TestFileHandlerProc, pipePtr); } else { - Tcl_AppendResult(interp, "bad read mode \"", argv[3], "\"", NULL); + Tcl_AppendResult(interp, "bad read mode \"", Tcl_GetString(objv[3]), "\"", NULL); return TCL_ERROR; } - if (strcmp(argv[4], "writable") == 0) { + if (strcmp(Tcl_GetString(objv[4]), "writable") == 0) { Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), TCL_WRITABLE, TestFileHandlerProc, pipePtr); - } else if (strcmp(argv[4], "off") == 0) { + } else if (strcmp(Tcl_GetString(objv[4]), "off") == 0) { Tcl_DeleteFileHandler(GetFd(pipePtr->writeFile)); - } else if (strcmp(argv[4], "disabled") == 0) { + } else if (strcmp(Tcl_GetString(objv[4]), "disabled") == 0) { Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), 0, TestFileHandlerProc, pipePtr); } else { - Tcl_AppendResult(interp, "bad read mode \"", argv[4], "\"", NULL); + Tcl_AppendResult(interp, "bad read mode \"", Tcl_GetString(objv[4]), "\"", NULL); return TCL_ERROR; } - } else if (strcmp(argv[1], "empty") == 0) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " empty index\"", NULL); + } else if (strcmp(Tcl_GetString(objv[1]), "empty") == 0) { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "index"); return TCL_ERROR; } while (read(GetFd(pipePtr->readFile), buffer, 4000) > 0) { /* Empty loop body. */ } - } else if (strcmp(argv[1], "fill") == 0) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " fill index\"", NULL); + } else if (strcmp(Tcl_GetString(objv[1]), "fill") == 0) { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "index"); return TCL_ERROR; } memset(buffer, 'a', 4000); - while (write(GetFd(pipePtr->writeFile), buffer, 4000) > 0) { + while (write(GetFd(pipePtr->writeFile), buffer, 4000) > 0) { /* Empty loop body. */ - } - } else if (strcmp(argv[1], "fillpartial") == 0) { + } + } else if (strcmp(Tcl_GetString(objv[1]), "fillpartial") == 0) { char buf[TCL_INTEGER_SPACE]; - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " fillpartial index\"", NULL); + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "index"); return TCL_ERROR; } memset(buffer, 'b', 10); TclFormatInt(buf, write(GetFd(pipePtr->writeFile), buffer, 10)); Tcl_AppendResult(interp, buf, NULL); - } else if (strcmp(argv[1], "oneevent") == 0) { + } else if (strcmp(Tcl_GetString(objv[1]), "oneevent") == 0) { Tcl_DoOneEvent(TCL_FILE_EVENTS|TCL_DONT_WAIT); - } else if (strcmp(argv[1], "wait") == 0) { - if (argc != 5) { - Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " wait index readable|writable timeout\"", NULL); + } else if (strcmp(Tcl_GetString(objv[1]), "wait") == 0) { + if (objc != 5) { + Tcl_WrongNumArgs(interp, 2, objv, "index readable|writable timeout"); return TCL_ERROR; } if (pipePtr->readFile == NULL) { - Tcl_AppendResult(interp, "pipe ", argv[2], " doesn't exist", NULL); + Tcl_AppendResult(interp, "pipe ", Tcl_GetString(objv[2]), " doesn't exist", NULL); return TCL_ERROR; } - if (strcmp(argv[3], "readable") == 0) { + if (strcmp(Tcl_GetString(objv[3]), "readable") == 0) { mask = TCL_READABLE; file = pipePtr->readFile; } else { mask = TCL_WRITABLE; file = pipePtr->writeFile; } - if (Tcl_GetInt(interp, argv[4], &timeout) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[4], &timeout) != TCL_OK) { return TCL_ERROR; } i = TclUnixWaitForFile(GetFd(file), mask, timeout); @@ -314,10 +297,10 @@ TestfilehandlerCmd( if (i & TCL_WRITABLE) { Tcl_AppendElement(interp, "writable"); } - } else if (strcmp(argv[1], "windowevent") == 0) { + } else if (strcmp(Tcl_GetString(objv[1]), "windowevent") == 0) { Tcl_DoOneEvent(TCL_WINDOW_EVENTS|TCL_DONT_WAIT); } else { - Tcl_AppendResult(interp, "bad option \"", argv[1], + Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]), "\": must be close, clear, counts, create, empty, fill, " "fillpartial, oneevent, wait, or windowevent", NULL); return TCL_ERROR; @@ -362,31 +345,30 @@ static int TestfilewaitCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const *objv) /* Argument strings. */ { int mask, result, timeout; Tcl_Channel channel; int fd; ClientData data; - if (argc != 4) { - Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - " file readable|writable|both timeout\"", NULL); + if (objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "file readable|writable|both timeout"); return TCL_ERROR; } - channel = Tcl_GetChannel(interp, argv[1], NULL); + channel = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL); if (channel == NULL) { return TCL_ERROR; } - if (strcmp(argv[2], "readable") == 0) { + if (strcmp(Tcl_GetString(objv[2]), "readable") == 0) { mask = TCL_READABLE; - } else if (strcmp(argv[2], "writable") == 0){ + } else if (strcmp(Tcl_GetString(objv[2]), "writable") == 0){ mask = TCL_WRITABLE; - } else if (strcmp(argv[2], "both") == 0){ + } else if (strcmp(Tcl_GetString(objv[2]), "both") == 0){ mask = TCL_WRITABLE|TCL_READABLE; } else { - Tcl_AppendResult(interp, "bad argument \"", argv[2], + Tcl_AppendResult(interp, "bad argument \"", Tcl_GetString(objv[2]), "\": must be readable, writable, or both", NULL); return TCL_ERROR; } @@ -397,7 +379,7 @@ TestfilewaitCmd( return TCL_ERROR; } fd = PTR2INT(data); - if (Tcl_GetInt(interp, argv[3], &timeout) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[3], &timeout) != TCL_OK) { return TCL_ERROR; } result = TclUnixWaitForFile(fd, mask, timeout); @@ -431,21 +413,20 @@ static int TestfindexecutableCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const *objv) /* Argument strings. */ { Tcl_Obj *saveName; - if (argc != 2) { - Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - " argv0\"", NULL); + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "argv0"); return TCL_ERROR; } saveName = TclGetObjNameOfExecutable(); Tcl_IncrRefCount(saveName); - TclpFindExecutable(argv[1]); + TclpFindExecutable(Tcl_GetString(objv[1])); Tcl_SetObjResult(interp, TclGetObjNameOfExecutable()); TclSetObjNameOfExecutable(saveName, NULL); @@ -456,83 +437,7 @@ TestfindexecutableCmd( /* *---------------------------------------------------------------------- * - * TestgetopenfileCmd -- - * - * This function implements the "testgetopenfile" command. It is used to - * get a FILE * value from a registered channel. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -TestgetopenfileCmd( - ClientData clientData, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ -{ - ClientData filePtr; - - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " channelName forWriting\"", NULL); - return TCL_ERROR; - } - if (Tcl_GetOpenFile(interp, argv[1], atoi(argv[2]), 1, &filePtr) - == TCL_ERROR) { - return TCL_ERROR; - } - if (filePtr == NULL) { - Tcl_AppendResult(interp, - "Tcl_GetOpenFile succeeded but FILE * NULL!", NULL); - return TCL_ERROR; - } - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TestsetencpathCmd -- - * - * This function implements the "testsetencpath" command. It is used to - * test Tcl_SetDefaultEncodingDir(). - * - * Results: - * A standard Tcl result. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -TestsetencpathObjCmd( - ClientData clientData, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const *objv) /* Argument strings. */ -{ - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "defaultDir"); - return TCL_ERROR; - } - - Tcl_SetEncodingSearchPath(objv[1]); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TestforkObjCmd -- + * TestforkCmd -- * * This function implements the "testfork" command. It is used to * fork the Tcl process for specific test cases. @@ -547,7 +452,7 @@ TestsetencpathObjCmd( */ static int -TestforkObjCmd( +TestforkCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -577,39 +482,6 @@ TestforkObjCmd( /* *---------------------------------------------------------------------- * - * TestgetencpathObjCmd -- - * - * This function implements the "testgetencpath" command. It is used to - * test Tcl_GetEncodingSearchPath(). - * - * Results: - * A standard Tcl result. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -TestgetencpathObjCmd( - ClientData clientData, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const *objv) /* Argument strings. */ -{ - if (objc != 1) { - Tcl_WrongNumArgs(interp, 1, objv, ""); - return TCL_ERROR; - } - - Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath()); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * * TestalarmCmd -- * * Test that EINTR is handled correctly by generating and handling a @@ -629,17 +501,15 @@ static int TestalarmCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const *objv) /* Argument strings. */ { #ifdef SA_RESTART - unsigned int sec; + unsigned int sec = 1; struct sigaction action; - if (argc > 1) { - Tcl_GetInt(interp, argv[1], (int *)&sec); - } else { - sec = 1; + if (objc > 1) { + Tcl_GetIntFromObj(interp, objv[1], (int *)&sec); } /* @@ -708,8 +578,8 @@ static int TestgotsigCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const *objv) /* Argument strings. */ { Tcl_AppendResult(interp, gotsig, NULL); gotsig = "0"; -- cgit v0.12 From 1ff9f7ba97eccee4788c69f811fd3925df40cd53 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 17 Sep 2019 10:45:04 +0000 Subject: Fix .travis.yml --- .travis.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.travis.yml b/.travis.yml index 23554f5..0d2a61e 100644 --- a/.travis.yml +++ b/.travis.yml @@ -344,7 +344,7 @@ matrix: script: - cmd.exe /C 'vcvarsall.bat x86 && nmake -f makefile.vc all tcltest' - cmd.exe /C 'vcvarsall.bat x86 && nmake -f makefile.vc test' - - name: "Windows/MSVC/Shared: UTF_MAX=6" + - name: "Windows/MSVC-x86/Shared: UTF_MAX=6" os: windows compiler: cl env: *vcenv @@ -353,7 +353,7 @@ matrix: script: - cmd.exe /C 'vcvarsall.bat x86 && nmake OPTS=utfmax -f makefile.vc all tcltest' - cmd.exe /C 'vcvarsall.bat x86 && nmake OPTS=utfmax -f makefile.vc test' - - name: "Windows/MSVC/Shared: NO_DEPRECATED" + - name: "Windows/MSVC-x86/Shared: NO_DEPRECATED" os: windows compiler: cl env: *vcenv @@ -439,7 +439,7 @@ matrix: - BUILD_DIR=win - CFGOPT="CFLAGS=-DTCL_UTF_MAX=6" before_install: *makepreinst - - name: "Windows/GCC-x86/Shared: UTF_MAX=3" + - name: "Windows/GCC-x86/Shared: UTF_MAX=3" os: windows compiler: gcc env: -- cgit v0.12 From f2f4614f5cd6f0493ed0e46688b28017c8fc93b9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 17 Sep 2019 13:01:46 +0000 Subject: Add missing constraints to test-cases --- tests/basic.test | 2 +- tests/lrange.test | 12 ++++++++---- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/tests/basic.test b/tests/basic.test index 0202679..5066877 100644 --- a/tests/basic.test +++ b/tests/basic.test @@ -968,7 +968,7 @@ test basic-48.24.$noComp {expansion: empty not canonical list, regression test, run {list [list {*}{ }] [list {*}[format %c 32]] [list {*}[set a { }]]} } -result [lrepeat 3 {}] -cleanup {unset -nocomplain a} -test basic-48.25.$noComp {Bug cc191552c: expansion: empty non-canonical list} -setup { +test basic-48.25.$noComp {Bug cc191552c: expansion: empty non-canonical list} -constraints $constraints -setup { unset -nocomplain ::CRLF set ::CRLF "\r\n" } -body { diff --git a/tests/lrange.test b/tests/lrange.test index 5bb4ee9..d5676ad 100644 --- a/tests/lrange.test +++ b/tests/lrange.test @@ -134,15 +134,19 @@ test lrange-3.7b.2 {not compiled on empty not list object, 2nd regression test, list [$cmd {} 0 1] [$cmd [lindex a -1] 0 1] [$cmd [set a {}] 0 1] \ [$cmd {} 0-1 end+1] [$cmd [lindex a -1] 0-1 end+1] [$cmd $a 0-1 end+1] } [lrepeat 6 {}] -test lrange-3.7c.2 {compiled on empty pure bytes object, 2nd regression test, bug [cc1e91552c]} { +test lrange-3.7c.2 {compiled on empty pure bytes object, 2nd regression test, bug [cc1e91552c]} -constraints { + testpurebytesobj +} -body { list [lrange [testpurebytesobj] 0 1] [lrange [testpurebytesobj { }] 0 1] [lrange [set a [testpurebytesobj {}]] 0 1] \ [lrange [testpurebytesobj] 0-1 end+1] [lrange [testpurebytesobj { }] 0-1 end+1] [lrange $a 0-1 end+1] -} [lrepeat 6 {}] -test lrange-3.7d.2 {not compiled on empty pure bytes object, 2nd regression test, bug [cc1e91552c]} { +} -result [lrepeat 6 {}] +test lrange-3.7d.2 {not compiled on empty pure bytes object, 2nd regression test, bug [cc1e91552c]} -constraints { + testpurebytesobj +} -body { set cmd lrange list [$cmd [testpurebytesobj] 0 1] [$cmd [testpurebytesobj { }] 0 1] [$cmd [set a [testpurebytesobj {}]] 0 1] \ [$cmd [testpurebytesobj] 0-1 end+1] [$cmd [testpurebytesobj { }] 0-1 end+1] [$cmd $a 0-1 end+1] -} [lrepeat 6 {}] +} -result [lrepeat 6 {}] # cleanup -- cgit v0.12 From bb14939c6492e648fedc29e6da35641e98b9c824 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 18 Sep 2019 09:36:56 +0000 Subject: Add 3 more builds with Clang (UTF_MAX=6, UTF_MAX=3, NO_DEPRECATED). Change build order a little: Do all static builds after the corresponding shared builds. --- .travis.yml | 70 +++++++++++++++++++++++++++++++++++++++---------------------- 1 file changed, 45 insertions(+), 25 deletions(-) diff --git a/.travis.yml b/.travis.yml index 0d2a61e..6562c0d 100644 --- a/.travis.yml +++ b/.travis.yml @@ -10,13 +10,6 @@ matrix: compiler: gcc env: - BUILD_DIR=unix - - name: "Linux/GCC/Static" - os: linux - dist: xenial - compiler: gcc - env: - - CFGOPT="--disable-shared" - - BUILD_DIR=unix - name: "Linux/GCC/Shared: UTF_MAX=6" os: linux dist: xenial @@ -37,8 +30,14 @@ matrix: compiler: gcc env: - BUILD_DIR=unix - - CFGOPT=CFLAGS=-DTCL_NO_DEPRECATED=1 -# Debug build. Running test-cases disabled, because it is currently failing. + - CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1" + - name: "Linux/GCC/Static" + os: linux + dist: xenial + compiler: gcc + env: + - CFGOPT="--disable-shared" + - BUILD_DIR=unix - name: "Linux/GCC/Debug" os: linux dist: xenial @@ -102,6 +101,27 @@ matrix: compiler: clang env: - BUILD_DIR=unix + - name: "Linux/Clang/Shared: UTF_MAX=6" + os: linux + dist: xenial + compiler: clang + env: + - BUILD_DIR=unix + - CFGOPT=CFLAGS=-DTCL_UTF_MAX=6 + - name: "Linux/Clang/Shared: UTF_MAX=3" + os: linux + dist: xenial + compiler: clang + env: + - BUILD_DIR=unix + - CFGOPT=CFLAGS=-DTCL_UTF_MAX=3 + - name: "Linux/Clang/Shared:NO_DEPRECATED" + os: linux + dist: xenial + compiler: clang + env: + - BUILD_DIR=unix + - CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1" - name: "Linux/Clang/Static" os: linux dist: xenial @@ -175,41 +195,41 @@ matrix: # Include a high visibility marker that tests are skipped outright - > echo "`tput setaf 3`SKIPPED TEST: CROSS COMPILING`tput sgr0`" - - name: "Linux-cross-Windows/GCC/Static/no test" + - name: "Linux-cross-Windows/GCC/Shared/no test: UTF_MAX=6" os: linux dist: xenial compiler: x86_64-w64-mingw32-gcc addons: *mingw64 env: - BUILD_DIR=win - - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit --disable-shared" + - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit CFLAGS=-DTCL_UTF_MAX=6" script: *crosstest - - name: "Linux-cross-Windows/GCC/Shared/no test: UTF_MAX=6" + - name: "Linux-cross-Windows/GCC/Shared/no test: UTF_MAX=3" os: linux dist: xenial compiler: x86_64-w64-mingw32-gcc addons: *mingw64 env: - BUILD_DIR=win - - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit CFLAGS=-DTCL_UTF_MAX=6" + - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit CFLAGS=-DTCL_UTF_MAX=3" script: *crosstest - - name: "Linux-cross-Windows/GCC/Shared/no test: UTF_MAX=3" + - name: "Linux-cross-Windows/GCC/Shared/no test: NO_DEPRECATED" os: linux dist: xenial compiler: x86_64-w64-mingw32-gcc addons: *mingw64 env: - BUILD_DIR=win - - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit CFLAGS=-DTCL_UTF_MAX=3" + - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit CFLAGS=-DTCL_NO_DEPRECATED=1" script: *crosstest - - name: "Linux-cross-Windows/GCC/Shared/no test: NO_DEPRECATED" + - name: "Linux-cross-Windows/GCC/Static/no test" os: linux dist: xenial compiler: x86_64-w64-mingw32-gcc addons: *mingw64 env: - BUILD_DIR=win - - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit CFLAGS=-DTCL_NO_DEPRECATED=1" + - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit --disable-shared" script: *crosstest - name: "Linux-cross-Windows/GCC/Debug/no test" os: linux @@ -239,41 +259,41 @@ matrix: - BUILD_DIR=win - CFGOPT=--host=i686-w64-mingw32 script: *crosstest - - name: "Linux-cross-Windows-32/GCC/Static/no test" + - name: "Linux-cross-Windows-32/GCC/Shared/no test: UTF_MAX=6" os: linux dist: xenial compiler: i686-w64-mingw32-gcc addons: *mingw32 env: - BUILD_DIR=win - - CFGOPT="--host=i686-w64-mingw32 --disable-shared" + - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_UTF_MAX=6" script: *crosstest - - name: "Linux-cross-Windows-32/GCC/Shared/no test: UTF_MAX=6" + - name: "Linux-cross-Windows-32/GCC/Shared/no test: UTF_MAX=3" os: linux dist: xenial compiler: i686-w64-mingw32-gcc addons: *mingw32 env: - BUILD_DIR=win - - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_UTF_MAX=6" + - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_UTF_MAX=3" script: *crosstest - - name: "Linux-cross-Windows-32/GCC/Shared/no test: UTF_MAX=3" + - name: "Linux-cross-Windows-32/GCC/Shared/no test: NO_DEPRECATED" os: linux dist: xenial compiler: i686-w64-mingw32-gcc addons: *mingw32 env: - BUILD_DIR=win - - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_UTF_MAX=3" + - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_NO_DEPRECATED=1" script: *crosstest - - name: "Linux-cross-Windows-32/GCC/Shared/no test: NO_DEPRECATED" + - name: "Linux-cross-Windows-32/GCC/Static/no test" os: linux dist: xenial compiler: i686-w64-mingw32-gcc addons: *mingw32 env: - BUILD_DIR=win - - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_NO_DEPRECATED=1" + - CFGOPT="--host=i686-w64-mingw32 --disable-shared" script: *crosstest - name: "Linux-cross-Windows-32/GCC/Debug/no test" os: linux -- cgit v0.12 From 3a94aaa6cb69b47612e4f299ef44bbb6d8869827 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 18 Sep 2019 15:11:23 +0000 Subject: TCHAR -> WCHAR converions (and corresponding Win32 API call changes), since we are impicitly compiling with -DUNICODE --- generic/tclIOSock.c | 2 +- generic/tclIOUtil.c | 2 +- win/tclWin32Dll.c | 46 +++++----- win/tclWinChan.c | 10 +-- win/tclWinConsole.c | 12 +-- win/tclWinFCmd.c | 246 ++++++++++++++++++++++++++-------------------------- win/tclWinFile.c | 212 ++++++++++++++++++++++---------------------- win/tclWinInit.c | 14 +-- win/tclWinInt.h | 10 +-- win/tclWinLoad.c | 8 +- win/tclWinNotify.c | 32 +++---- win/tclWinPipe.c | 76 ++++++++-------- win/tclWinSerial.c | 10 +-- win/tclWinSock.c | 16 ++-- 14 files changed, 349 insertions(+), 347 deletions(-) diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c index c5b7d28..8a1e3e6 100644 --- a/generic/tclIOSock.c +++ b/generic/tclIOSock.c @@ -29,7 +29,7 @@ static const char *gai_strerror(int code) { } else { tsdPtr->initialized = 1; } - Tcl_WinTCharToUtf(gai_strerrorW(code), -1, &tsdPtr->errorMsg); + Tcl_WinTCharToUtf((TCHAR *)gai_strerrorW(code), -1, &tsdPtr->errorMsg); return Tcl_DStringValue(&tsdPtr->errorMsg); } #endif diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 28b65ff..4235c3e 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -4669,7 +4669,7 @@ Tcl_FSGetFileSystemForPath( * Tcl_FSGetNativePath -- * * This function is for use by the Win/Unix native filesystems, so that - * they can easily retrieve the native (char* or TCHAR*) representation + * they can easily retrieve the native (char* or WCHAR*) representation * of a path. Other filesystems will probably want to implement similar * functions. They basically act as a safety net around * Tcl_FSGetInternalRep. Normally your file-system functions will always diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c index c8bb98b..e77fbc0 100644 --- a/win/tclWin32Dll.c +++ b/win/tclWin32Dll.c @@ -47,8 +47,8 @@ BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason, */ typedef struct MountPointMap { - TCHAR *volumeName; /* Native wide string volume name. */ - TCHAR driveLetter; /* Drive letter corresponding to the volume + WCHAR *volumeName; /* Native wide string volume name. */ + WCHAR driveLetter; /* Drive letter corresponding to the volume * name. */ struct MountPointMap *nextPtr; /* Pointer to next structure in list, or @@ -120,6 +120,8 @@ DllMain( DWORD reason, /* Reason this function is being called. */ LPVOID reserved) /* Not used. */ { + (void)reserved; + switch (reason) { case DLL_PROCESS_ATTACH: DisableThreadLibraryCalls(hInst); @@ -362,11 +364,11 @@ TclWinResetInterfaces(void) char TclWinDriveLetterForVolMountPoint( - const TCHAR *mountPoint) + const WCHAR *mountPoint) { MountPointMap *dlIter, *dlPtr2; - TCHAR Target[55]; /* Target of mount at mount point */ - TCHAR drive[4] = TEXT("A:\\"); + WCHAR Target[55]; /* Target of mount at mount point */ + WCHAR drive[4] = L"A:\\"; /* * Detect the volume mounted there. Unfortunately, there is no simple way @@ -377,22 +379,22 @@ TclWinDriveLetterForVolMountPoint( Tcl_MutexLock(&mountPointMap); dlIter = driveLetterLookup; while (dlIter != NULL) { - if (_tcscmp(dlIter->volumeName, mountPoint) == 0) { + if (wcscmp(dlIter->volumeName, mountPoint) == 0) { /* * We need to check whether this information is still valid, since * either the user or various programs could have adjusted the * mount points on the fly. */ - drive[0] = (TCHAR) dlIter->driveLetter; + drive[0] = (WCHAR) dlIter->driveLetter; /* * Try to read the volume mount point and see where it points. */ - if (GetVolumeNameForVolumeMountPoint(drive, + if (GetVolumeNameForVolumeMountPointW(drive, Target, 55) != 0) { - if (_tcscmp(dlIter->volumeName, Target) == 0) { + if (wcscmp(dlIter->volumeName, Target) == 0) { /* * Nothing has changed. */ @@ -449,13 +451,13 @@ TclWinDriveLetterForVolMountPoint( * Try to read the volume mount point and see where it points. */ - if (GetVolumeNameForVolumeMountPoint(drive, + if (GetVolumeNameForVolumeMountPointW(drive, Target, 55) != 0) { int alreadyStored = 0; for (dlIter = driveLetterLookup; dlIter != NULL; dlIter = dlIter->nextPtr) { - if (_tcscmp(dlIter->volumeName, Target) == 0) { + if (wcscmp(dlIter->volumeName, Target) == 0) { alreadyStored = 1; break; } @@ -476,7 +478,7 @@ TclWinDriveLetterForVolMountPoint( for (dlIter = driveLetterLookup; dlIter != NULL; dlIter = dlIter->nextPtr) { - if (_tcscmp(dlIter->volumeName, mountPoint) == 0) { + if (wcscmp(dlIter->volumeName, mountPoint) == 0) { Tcl_MutexUnlock(&mountPointMap); return (char) dlIter->driveLetter; } @@ -523,7 +525,7 @@ TclWinDriveLetterForVolMountPoint( * nativeBuffer <- UtfToExternal(encoding, utfBuffer); * Tcl_FreeEncoding(encoding); * - * By convention, in Windows a TCHAR is a Unicode character. If you plan + * By convention, in Windows a WCHAR is a Unicode character. If you plan * on targeting a Unicode interface when running on Windows, these * functions should be used. If you plan on targetting a "char" oriented * function on Windows, use Tcl_UtfToExternal() with an encoding of NULL. @@ -581,8 +583,8 @@ Tcl_WinUtfToTChar( while (p < end) { p += TclUtfToUniChar(p, &ch); if (ch > 0xFFFF) { - *w++ = (wchar_t) (0xD800 + ((ch -= 0x10000) >> 10)); - *w++ = (wchar_t) (0xDC00 | (ch & 0x3FF)); + *w++ = (WCHAR) (0xD800 + ((ch -= 0x10000) >> 10)); + *w++ = (WCHAR) (0xDC00 | (ch & 0x3FF)); } else { *w++ = ch; } @@ -595,8 +597,8 @@ Tcl_WinUtfToTChar( ch = UCHAR(*p++); } if (ch > 0xFFFF) { - *w++ = (wchar_t) (0xD800 + ((ch -= 0x10000) >> 10)); - *w++ = (wchar_t) (0xDC00 | (ch & 0x3FF)); + *w++ = (WCHAR) (0xD800 + ((ch -= 0x10000) >> 10)); + *w++ = (WCHAR) (0xDC00 | (ch & 0x3FF)); } else { *w++ = ch; } @@ -607,7 +609,7 @@ Tcl_WinUtfToTChar( return wString; #else - return Tcl_UtfToUniCharDString(string, len, dsPtr); + return (TCHAR *)Tcl_UtfToUniCharDString(string, len, dsPtr); #endif } @@ -620,7 +622,7 @@ Tcl_WinTCharToUtf( * converted string is stored. */ { #if TCL_UTF_MAX > 4 - const TCHAR *w, *wEnd; + const WCHAR *w, *wEnd; char *p, *result; int oldLength, blen = 1; #endif @@ -630,7 +632,7 @@ Tcl_WinTCharToUtf( return NULL; } if (len < 0) { - len = wcslen((TCHAR *)string); + len = wcslen((WCHAR *)string); } else { len /= 2; } @@ -640,8 +642,8 @@ Tcl_WinTCharToUtf( result = Tcl_DStringValue(dsPtr) + oldLength; p = result; - wEnd = (TCHAR *)string + len; - for (w = (TCHAR *)string; w < wEnd; ) { + wEnd = (WCHAR *)string + len; + for (w = (WCHAR *)string; w < wEnd; ) { if (!blen && ((*w & 0xFC00) != 0xDC00)) { /* Special case for handling high surrogates. */ p += Tcl_UniCharToUtf(-1, p); diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 78b510b..209b860 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -95,7 +95,7 @@ static void FileThreadActionProc(ClientData instanceData, static int FileTruncateProc(ClientData instanceData, Tcl_WideInt length); static DWORD FileGetType(HANDLE handle); -static int NativeIsComPort(const TCHAR *nativeName); +static int NativeIsComPort(const WCHAR *nativeName); /* * This structure describes the channel type structure for file based IO. */ @@ -836,7 +836,7 @@ TclpOpenFileChannel( Tcl_Channel channel = 0; int channelPermissions = 0; DWORD accessMode = 0, createMode, shareMode, flags; - const TCHAR *nativeName; + const WCHAR *nativeName; HANDLE handle; char channelName[16 + TCL_INTEGER_SPACE]; TclFile readFile = NULL, writeFile = NULL; @@ -932,7 +932,7 @@ TclpOpenFileChannel( flags = FILE_ATTRIBUTE_READONLY; } } else { - flags = GetFileAttributes(nativeName); + flags = GetFileAttributesW(nativeName); if (flags == 0xFFFFFFFF) { flags = 0; } @@ -948,7 +948,7 @@ TclpOpenFileChannel( * Now we get to create the file. */ - handle = CreateFile(nativeName, accessMode, shareMode, + handle = CreateFileW(nativeName, accessMode, shareMode, NULL, createMode, flags, (HANDLE) NULL); if (handle == INVALID_HANDLE_VALUE) { @@ -1540,7 +1540,7 @@ FileGetType( static int NativeIsComPort( - const TCHAR *nativePath) /* Path of file to access, native encoding. */ + const WCHAR *nativePath) /* Path of file to access, native encoding. */ { const WCHAR *p = (const WCHAR *) nativePath; int i, len = wcslen(p); diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index d61a030..6800115 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -193,8 +193,8 @@ static const Tcl_ChannelType consoleChannelType = { * * ReadConsoleBytes, WriteConsoleBytes -- * - * Wrapper for ReadConsole{A,W}, that takes and returns number of bytes - * instead of number of TCHARS. + * Wrapper for ReadConsoleW, that takes and returns number of bytes + * instead of number of WCHARS. * *---------------------------------------------------------------------- */ @@ -208,7 +208,7 @@ ReadConsoleBytes( { DWORD ntchars; BOOL result; - int tcharsize = sizeof(TCHAR); + int tcharsize = sizeof(WCHAR); /* * If user types a Ctrl-Break or Ctrl-C, ReadConsole will return @@ -221,7 +221,7 @@ ReadConsoleBytes( * will run and take whatever action it deems appropriate. */ do { - result = ReadConsole(hConsole, lpBuffer, nbytes / tcharsize, &ntchars, + result = ReadConsoleW(hConsole, lpBuffer, nbytes / tcharsize, &ntchars, NULL); } while (result && ntchars == 0 && GetLastError() == ERROR_OPERATION_ABORTED); if (nbytesread != NULL) { @@ -239,9 +239,9 @@ WriteConsoleBytes( { DWORD ntchars; BOOL result; - int tcharsize = sizeof(TCHAR); + int tcharsize = sizeof(WCHAR); - result = WriteConsole(hConsole, lpBuffer, nbytes / tcharsize, &ntchars, + result = WriteConsoleW(hConsole, lpBuffer, nbytes / tcharsize, &ntchars, NULL); if (nbyteswritten != NULL) { *nbyteswritten = ntchars * tcharsize; diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index 2f28154..9df9d82 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -71,7 +71,7 @@ const TclFileAttrProcs tclpFileAttrProcs[] = { * Prototype for the TraverseWinTree callback function. */ -typedef int (TraversalProc)(const TCHAR *srcPtr, const TCHAR *dstPtr, +typedef int (TraversalProc)(const WCHAR *srcPtr, const WCHAR *dstPtr, int type, Tcl_DString *errorPtr); /* @@ -82,18 +82,18 @@ static void StatError(Tcl_Interp *interp, Tcl_Obj *fileName); static int ConvertFileNameFormat(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, int longShort, Tcl_Obj **attributePtrPtr); -static int DoCopyFile(const TCHAR *srcPtr, const TCHAR *dstPtr); -static int DoCreateDirectory(const TCHAR *pathPtr); -static int DoRemoveJustDirectory(const TCHAR *nativeSrc, +static int DoCopyFile(const WCHAR *srcPtr, const WCHAR *dstPtr); +static int DoCreateDirectory(const WCHAR *pathPtr); +static int DoRemoveJustDirectory(const WCHAR *nativeSrc, int ignoreError, Tcl_DString *errorPtr); static int DoRemoveDirectory(Tcl_DString *pathPtr, int recursive, Tcl_DString *errorPtr); -static int DoRenameFile(const TCHAR *nativeSrc, - const TCHAR *dstPtr); -static int TraversalCopy(const TCHAR *srcPtr, const TCHAR *dstPtr, +static int DoRenameFile(const WCHAR *nativeSrc, + const WCHAR *dstPtr); +static int TraversalCopy(const WCHAR *srcPtr, const WCHAR *dstPtr, int type, Tcl_DString *errorPtr); -static int TraversalDelete(const TCHAR *srcPtr, - const TCHAR *dstPtr, int type, +static int TraversalDelete(const WCHAR *srcPtr, + const WCHAR *dstPtr, int type, Tcl_DString *errorPtr); static int TraverseWinTree(TraversalProc *traverseProc, Tcl_DString *sourcePtr, Tcl_DString *dstPtr, @@ -151,9 +151,9 @@ TclpObjRenameFile( static int DoRenameFile( - const TCHAR *nativeSrc, /* Pathname of file or dir to be renamed + const WCHAR *nativeSrc, /* Pathname of file or dir to be renamed * (native). */ - const TCHAR *nativeDst) /* New pathname for file or directory + const WCHAR *nativeDst) /* New pathname for file or directory * (native). */ { #if defined(HAVE_NO_SEH) && !defined(_WIN64) @@ -163,7 +163,7 @@ DoRenameFile( int retval = -1; /* - * The MoveFile API acts differently under Win95/98 and NT WRT NULL and + * The MoveFileW API acts differently under Win95/98 and NT WRT NULL and * "". Avoid passing these values. */ @@ -174,7 +174,7 @@ DoRenameFile( } /* - * The MoveFile API would throw an exception under NT if one of the + * The MoveFileW API would throw an exception under NT if one of the * arguments is a char block device. */ @@ -195,7 +195,7 @@ DoRenameFile( /* * Construct an TCLEXCEPTION_REGISTRATION to protect the call to - * MoveFile. + * MoveFileW. */ "leal %[registration], %%edx" "\n\t" @@ -214,17 +214,17 @@ DoRenameFile( "movl %%edx, %%fs:0" "\n\t" /* - * Call MoveFile(nativeSrc, nativeDst) + * Call MoveFileW(nativeSrc, nativeDst) */ "pushl %%ebx" "\n\t" "pushl %%ecx" "\n\t" - "movl %[moveFile], %%eax" "\n\t" + "movl %[moveFileW], %%eax" "\n\t" "call *%%eax" "\n\t" /* * Come here on normal exit. Recover the TCLEXCEPTION_REGISTRATION and - * put the status return from MoveFile into it. + * put the status return from MoveFileW into it. */ "movl %%fs:0, %%edx" "\n\t" @@ -256,7 +256,7 @@ DoRenameFile( [registration] "m" (registration), [nativeDst] "m" (nativeDst), [nativeSrc] "m" (nativeSrc), - [moveFile] "r" (MoveFile) + [moveFileW] "r" (MoveFileW) : "%eax", "%ebx", "%ecx", "%edx", "memory" ); @@ -267,7 +267,7 @@ DoRenameFile( #ifndef HAVE_NO_SEH __try { #endif - if ((*MoveFile)(nativeSrc, nativeDst) != FALSE) { + if ((*MoveFileW)(nativeSrc, nativeDst) != FALSE) { retval = TCL_OK; } #ifndef HAVE_NO_SEH @@ -281,10 +281,10 @@ DoRenameFile( TclWinConvertError(GetLastError()); - srcAttr = GetFileAttributes(nativeSrc); - dstAttr = GetFileAttributes(nativeDst); + srcAttr = GetFileAttributesW(nativeSrc); + dstAttr = GetFileAttributesW(nativeDst); if (srcAttr == 0xffffffff) { - if (GetFullPathName(nativeSrc, 0, NULL, + if (GetFullPathNameW(nativeSrc, 0, NULL, NULL) >= MAX_PATH) { errno = ENAMETOOLONG; return TCL_ERROR; @@ -292,7 +292,7 @@ DoRenameFile( srcAttr = 0; } if (dstAttr == 0xffffffff) { - if (GetFullPathName(nativeDst, 0, NULL, + if (GetFullPathNameW(nativeDst, 0, NULL, NULL) >= MAX_PATH) { errno = ENAMETOOLONG; return TCL_ERROR; @@ -307,29 +307,29 @@ DoRenameFile( if (errno == EACCES) { decode: if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) { - TCHAR *nativeSrcRest, *nativeDstRest; + WCHAR *nativeSrcRest, *nativeDstRest; const char **srcArgv, **dstArgv; int size, srcArgc, dstArgc; - TCHAR nativeSrcPath[MAX_PATH]; - TCHAR nativeDstPath[MAX_PATH]; + WCHAR nativeSrcPath[MAX_PATH]; + WCHAR nativeDstPath[MAX_PATH]; Tcl_DString srcString, dstString; const char *src, *dst; - size = GetFullPathName(nativeSrc, MAX_PATH, + size = GetFullPathNameW(nativeSrc, MAX_PATH, nativeSrcPath, &nativeSrcRest); if ((size == 0) || (size > MAX_PATH)) { return TCL_ERROR; } - size = GetFullPathName(nativeDst, MAX_PATH, + size = GetFullPathNameW(nativeDst, MAX_PATH, nativeDstPath, &nativeDstRest); if ((size == 0) || (size > MAX_PATH)) { return TCL_ERROR; } - CharLower(nativeSrcPath); - CharLower(nativeDstPath); + CharLowerW(nativeSrcPath); + CharLowerW(nativeDstPath); - src = Tcl_WinTCharToUtf(nativeSrcPath, -1, &srcString); - dst = Tcl_WinTCharToUtf(nativeDstPath, -1, &dstString); + src = Tcl_WinTCharToUtf((TCHAR *)nativeSrcPath, -1, &srcString); + dst = Tcl_WinTCharToUtf((TCHAR *)nativeDstPath, -1, &dstString); /* * Check whether the destination path is actually inside the @@ -369,7 +369,7 @@ DoRenameFile( * errno should be EXDEV. It is very important to get this * behavior, so that the caller can respond to a cross * filesystem rename by simulating it with copy and delete. - * The MoveFile system call already handles the case of moving + * The MoveFileW system call already handles the case of moving * a file between filesystems. */ @@ -408,7 +408,7 @@ DoRenameFile( * directory back, for completeness. */ - if (MoveFile(nativeSrc, + if (MoveFileW(nativeSrc, nativeDst) != FALSE) { return TCL_OK; } @@ -419,8 +419,8 @@ DoRenameFile( */ TclWinConvertError(GetLastError()); - CreateDirectory(nativeDst, NULL); - SetFileAttributes(nativeDst, dstAttr); + CreateDirectoryW(nativeDst, NULL); + SetFileAttributesW(nativeDst, dstAttr); if (Tcl_GetErrno() == EACCES) { /* * Decode the EACCES to a more meaningful error. @@ -445,39 +445,39 @@ DoRenameFile( * back to old name. */ - TCHAR *nativeRest, *nativeTmp, *nativePrefix; + WCHAR *nativeRest, *nativeTmp, *nativePrefix; int result, size; - TCHAR tempBuf[MAX_PATH]; + WCHAR tempBuf[MAX_PATH]; - size = GetFullPathName(nativeDst, MAX_PATH, + size = GetFullPathNameW(nativeDst, MAX_PATH, tempBuf, &nativeRest); if ((size == 0) || (size > MAX_PATH) || (nativeRest == NULL)) { return TCL_ERROR; } - nativeTmp = (TCHAR *) tempBuf; + nativeTmp = (WCHAR *) tempBuf; nativeRest[0] = L'\0'; result = TCL_ERROR; - nativePrefix = (TCHAR *) L"tclr"; - if (GetTempFileName(nativeTmp, nativePrefix, + nativePrefix = (WCHAR *) L"tclr"; + if (GetTempFileNameW(nativeTmp, nativePrefix, 0, tempBuf) != 0) { /* * Strictly speaking, need the following DeleteFile and - * MoveFile to be joined as an atomic operation so no + * MoveFileW to be joined as an atomic operation so no * other app comes along in the meantime and creates the * same temp file. */ nativeTmp = tempBuf; - DeleteFile(nativeTmp); - if (MoveFile(nativeDst, nativeTmp) != FALSE) { - if (MoveFile(nativeSrc, nativeDst) != FALSE) { - SetFileAttributes(nativeTmp, FILE_ATTRIBUTE_NORMAL); - DeleteFile(nativeTmp); + DeleteFileW(nativeTmp); + if (MoveFileW(nativeDst, nativeTmp) != FALSE) { + if (MoveFileW(nativeSrc, nativeDst) != FALSE) { + SetFileAttributesW(nativeTmp, FILE_ATTRIBUTE_NORMAL); + DeleteFileW(nativeTmp); return TCL_OK; } else { - DeleteFile(nativeDst); - MoveFile(nativeTmp, nativeDst); + DeleteFileW(nativeDst); + MoveFileW(nativeTmp, nativeDst); } } @@ -540,8 +540,8 @@ TclpObjCopyFile( static int DoCopyFile( - const TCHAR *nativeSrc, /* Pathname of file to be copied (native). */ - const TCHAR *nativeDst) /* Pathname of file to copy to (native). */ + const WCHAR *nativeSrc, /* Pathname of file to be copied (native). */ + const WCHAR *nativeDst) /* Pathname of file to copy to (native). */ { #if defined(HAVE_NO_SEH) && !defined(_WIN64) TCLEXCEPTION_REGISTRATION registration; @@ -601,10 +601,10 @@ DoCopyFile( "movl %%edx, %%fs:0" "\n\t" /* - * Call CopyFile(nativeSrc, nativeDst, 0) + * Call CopyFileW(nativeSrc, nativeDst, 0) */ - "movl %[copyFile], %%eax" "\n\t" + "movl %[copyFileW], %%eax" "\n\t" "pushl $0" "\n\t" "pushl %%ebx" "\n\t" "pushl %%ecx" "\n\t" @@ -644,7 +644,7 @@ DoCopyFile( [registration] "m" (registration), [nativeDst] "m" (nativeDst), [nativeSrc] "m" (nativeSrc), - [copyFile] "r" (CopyFile) + [copyFileW] "r" (CopyFileW) : "%eax", "%ebx", "%ecx", "%edx", "memory" ); @@ -655,7 +655,7 @@ DoCopyFile( #ifndef HAVE_NO_SEH __try { #endif - if (CopyFile(nativeSrc, nativeDst, 0) != FALSE) { + if (CopyFileW(nativeSrc, nativeDst, 0) != FALSE) { retval = TCL_OK; } #ifndef HAVE_NO_SEH @@ -675,8 +675,8 @@ DoCopyFile( if (Tcl_GetErrno() == EACCES) { DWORD srcAttr, dstAttr; - srcAttr = GetFileAttributes(nativeSrc); - dstAttr = GetFileAttributes(nativeDst); + srcAttr = GetFileAttributesW(nativeSrc); + dstAttr = GetFileAttributesW(nativeDst); if (srcAttr != 0xffffffff) { if (dstAttr == 0xffffffff) { dstAttr = 0; @@ -692,9 +692,9 @@ DoCopyFile( Tcl_SetErrno(EISDIR); } if (dstAttr & FILE_ATTRIBUTE_READONLY) { - SetFileAttributes(nativeDst, + SetFileAttributesW(nativeDst, dstAttr & ~((DWORD)FILE_ATTRIBUTE_READONLY)); - if (CopyFile(nativeSrc, nativeDst, + if (CopyFileW(nativeSrc, nativeDst, 0) != FALSE) { return TCL_OK; } @@ -705,7 +705,7 @@ DoCopyFile( */ TclWinConvertError(GetLastError()); - SetFileAttributes(nativeDst, dstAttr); + SetFileAttributesW(nativeDst, dstAttr); } } } @@ -749,7 +749,7 @@ TclpDeleteFile( const void *nativePath) /* Pathname of file to be removed (native). */ { DWORD attr; - const TCHAR *path = nativePath; + const WCHAR *path = nativePath; /* * The DeleteFile API acts differently under Win95/98 and NT WRT NULL and @@ -761,13 +761,13 @@ TclpDeleteFile( return TCL_ERROR; } - if (DeleteFile(path) != FALSE) { + if (DeleteFileW(path) != FALSE) { return TCL_OK; } TclWinConvertError(GetLastError()); if (Tcl_GetErrno() == EACCES) { - attr = GetFileAttributes(path); + attr = GetFileAttributesW(path); if (attr != 0xffffffff) { if (attr & FILE_ATTRIBUTE_DIRECTORY) { if (attr & FILE_ATTRIBUTE_REPARSE_POINT) { @@ -788,21 +788,21 @@ TclpDeleteFile( Tcl_SetErrno(EISDIR); } else if (attr & FILE_ATTRIBUTE_READONLY) { - int res = SetFileAttributes(path, + int res = SetFileAttributesW(path, attr & ~((DWORD) FILE_ATTRIBUTE_READONLY)); if ((res != 0) && - (DeleteFile(path) != FALSE)) { + (DeleteFileW(path) != FALSE)) { return TCL_OK; } TclWinConvertError(GetLastError()); if (res != 0) { - SetFileAttributes(path, attr); + SetFileAttributesW(path, attr); } } } } else if (Tcl_GetErrno() == ENOENT) { - attr = GetFileAttributes(path); + attr = GetFileAttributesW(path); if (attr != 0xffffffff) { if (attr & FILE_ATTRIBUTE_DIRECTORY) { /* @@ -859,9 +859,9 @@ TclpObjCreateDirectory( static int DoCreateDirectory( - const TCHAR *nativePath) /* Pathname of directory to create (native). */ + const WCHAR *nativePath) /* Pathname of directory to create (native). */ { - if (CreateDirectory(nativePath, NULL) == 0) { + if (CreateDirectoryW(nativePath, NULL) == 0) { DWORD error = GetLastError(); TclWinConvertError(error); @@ -1009,7 +1009,7 @@ TclpObjRemoveDirectory( static int DoRemoveJustDirectory( - const TCHAR *nativePath, /* Pathname of directory to be removed + const WCHAR *nativePath, /* Pathname of directory to be removed * (native). */ int ignoreError, /* If non-zero, don't initialize the errorPtr * under some circumstances on return. */ @@ -1030,7 +1030,7 @@ DoRemoveJustDirectory( return TCL_ERROR; } - attr = GetFileAttributes(nativePath); + attr = GetFileAttributesW(nativePath); if (attr & FILE_ATTRIBUTE_REPARSE_POINT) { /* @@ -1044,7 +1044,7 @@ DoRemoveJustDirectory( * Ordinary directory. */ - if (RemoveDirectory(nativePath) != FALSE) { + if (RemoveDirectoryW(nativePath) != FALSE) { return TCL_OK; } } @@ -1052,7 +1052,7 @@ DoRemoveJustDirectory( TclWinConvertError(GetLastError()); if (Tcl_GetErrno() == EACCES) { - attr = GetFileAttributes(nativePath); + attr = GetFileAttributesW(nativePath); if (attr != 0xffffffff) { if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) { /* @@ -1076,15 +1076,15 @@ DoRemoveJustDirectory( if (attr & FILE_ATTRIBUTE_READONLY) { attr &= ~FILE_ATTRIBUTE_READONLY; - if (SetFileAttributes(nativePath, + if (SetFileAttributesW(nativePath, attr) == FALSE) { goto end; } - if (RemoveDirectory(nativePath) != FALSE) { + if (RemoveDirectoryW(nativePath) != FALSE) { return TCL_OK; } TclWinConvertError(GetLastError()); - SetFileAttributes(nativePath, + SetFileAttributesW(nativePath, attr | FILE_ATTRIBUTE_READONLY); } } @@ -1109,7 +1109,7 @@ DoRemoveJustDirectory( end: if (errorPtr != NULL) { - char *p = Tcl_WinTCharToUtf(nativePath, -1, errorPtr); + char *p = Tcl_WinTCharToUtf((TCHAR *)nativePath, -1, errorPtr); for (; *p; ++p) { if (*p == '\\') *p = '/'; } @@ -1129,7 +1129,7 @@ DoRemoveDirectory( * filled with UTF-8 name of file causing * error. */ { - int res = DoRemoveJustDirectory((const TCHAR *)Tcl_DStringValue(pathPtr), recursive, + int res = DoRemoveJustDirectory((const WCHAR *)Tcl_DStringValue(pathPtr), recursive, errorPtr); if ((res == TCL_ERROR) && (recursive != 0) && (Tcl_GetErrno() == EEXIST)) { @@ -1180,21 +1180,21 @@ TraverseWinTree( * error. */ { DWORD sourceAttr; - TCHAR *nativeSource, *nativeTarget, *nativeErrfile; + WCHAR *nativeSource, *nativeTarget, *nativeErrfile; int result, found, sourceLen, targetLen = 0, oldSourceLen, oldTargetLen; HANDLE handle; - WIN32_FIND_DATA data; + WIN32_FIND_DATAW data; nativeErrfile = NULL; result = TCL_OK; oldTargetLen = 0; /* lint. */ - nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr); - nativeTarget = (TCHAR *) + nativeSource = (WCHAR *) Tcl_DStringValue(sourcePtr); + nativeTarget = (WCHAR *) (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)); oldSourceLen = Tcl_DStringLength(sourcePtr); - sourceAttr = GetFileAttributes(nativeSource); + sourceAttr = GetFileAttributesW(nativeSource); if (sourceAttr == 0xffffffff) { nativeErrfile = nativeSource; goto end; @@ -1217,11 +1217,11 @@ TraverseWinTree( return traverseProc(nativeSource, nativeTarget, DOTREE_F, errorPtr); } - Tcl_DStringAppend(sourcePtr, (char *) TEXT("\\*.*"), 4 * sizeof(TCHAR) + 1); + Tcl_DStringAppend(sourcePtr, (char *) L"\\*.*", 4 * sizeof(WCHAR) + 1); Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1); - nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr); - handle = FindFirstFile(nativeSource, &data); + nativeSource = (WCHAR *) Tcl_DStringValue(sourcePtr); + handle = FindFirstFileW(nativeSource, &data); if (handle == INVALID_HANDLE_VALUE) { /* * Can't read directory. @@ -1241,24 +1241,24 @@ TraverseWinTree( return result; } - sourceLen = oldSourceLen + sizeof(TCHAR); - Tcl_DStringAppend(sourcePtr, (char *) TEXT("\\"), sizeof(TCHAR) + 1); + sourceLen = oldSourceLen + sizeof(WCHAR); + Tcl_DStringAppend(sourcePtr, (char *) L"\\", sizeof(WCHAR) + 1); Tcl_DStringSetLength(sourcePtr, sourceLen); if (targetPtr != NULL) { oldTargetLen = Tcl_DStringLength(targetPtr); targetLen = oldTargetLen; - targetLen += sizeof(TCHAR); - Tcl_DStringAppend(targetPtr, (char *) TEXT("\\"), sizeof(TCHAR) + 1); + targetLen += sizeof(WCHAR); + Tcl_DStringAppend(targetPtr, (char *) L"\\", sizeof(WCHAR) + 1); Tcl_DStringSetLength(targetPtr, targetLen); } found = 1; - for (; found; found = FindNextFile(handle, &data)) { - TCHAR *nativeName; - int len; + for (; found; found = FindNextFileW(handle, &data)) { + WCHAR *nativeName; + size_t len; - TCHAR *wp = data.cFileName; + WCHAR *wp = data.cFileName; if (*wp == '.') { wp++; if (*wp == '.') { @@ -1268,8 +1268,8 @@ TraverseWinTree( continue; } } - nativeName = (TCHAR *) data.cFileName; - len = _tcslen(data.cFileName) * sizeof(TCHAR); + nativeName = (WCHAR *) data.cFileName; + len = wcslen(data.cFileName) * sizeof(WCHAR); /* * Append name after slash, and recurse on the file. @@ -1314,8 +1314,8 @@ TraverseWinTree( * files in that directory. */ - result = traverseProc((const TCHAR *)Tcl_DStringValue(sourcePtr), - (const TCHAR *)(targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)), + result = traverseProc((const WCHAR *)Tcl_DStringValue(sourcePtr), + (const WCHAR *)(targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)), DOTREE_POSTD, errorPtr); } @@ -1323,7 +1323,7 @@ TraverseWinTree( if (nativeErrfile != NULL) { TclWinConvertError(GetLastError()); if (errorPtr != NULL) { - Tcl_WinTCharToUtf(nativeErrfile, -1, errorPtr); + Tcl_WinTCharToUtf((TCHAR *)nativeErrfile, -1, errorPtr); } result = TCL_ERROR; } @@ -1350,8 +1350,8 @@ TraverseWinTree( static int TraversalCopy( - const TCHAR *nativeSrc, /* Source pathname to copy. */ - const TCHAR *nativeDst, /* Destination pathname of copy. */ + const WCHAR *nativeSrc, /* Source pathname to copy. */ + const WCHAR *nativeDst, /* Destination pathname of copy. */ int type, /* Reason for call - see TraverseWinTree() */ Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled * with UTF-8 name of file causing error. */ @@ -1369,9 +1369,9 @@ TraversalCopy( break; case DOTREE_PRED: if (DoCreateDirectory(nativeDst) == TCL_OK) { - DWORD attr = GetFileAttributes(nativeSrc); + DWORD attr = GetFileAttributesW(nativeSrc); - if (SetFileAttributes(nativeDst, + if (SetFileAttributesW(nativeDst, attr) != FALSE) { return TCL_OK; } @@ -1388,7 +1388,7 @@ TraversalCopy( */ if (errorPtr != NULL) { - Tcl_WinTCharToUtf(nativeDst, -1, errorPtr); + Tcl_WinTCharToUtf((TCHAR *)nativeDst, -1, errorPtr); } return TCL_ERROR; } @@ -1416,8 +1416,8 @@ TraversalCopy( static int TraversalDelete( - const TCHAR *nativeSrc, /* Source pathname to delete. */ - const TCHAR *dstPtr, /* Not used. */ + const WCHAR *nativeSrc, /* Source pathname to delete. */ + const WCHAR *dstPtr, /* Not used. */ int type, /* Reason for call - see TraverseWinTree() */ Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled * with UTF-8 name of file causing error. */ @@ -1443,7 +1443,7 @@ TraversalDelete( } if (errorPtr != NULL) { - Tcl_WinTCharToUtf(nativeSrc, -1, errorPtr); + Tcl_WinTCharToUtf((TCHAR *)nativeSrc, -1, errorPtr); } return TCL_ERROR; } @@ -1503,11 +1503,11 @@ GetWinFileAttributes( Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { DWORD result; - const TCHAR *nativeName; + const WCHAR *nativeName; int attr; nativeName = Tcl_FSGetNativePath(fileName); - result = GetFileAttributes(nativeName); + result = GetFileAttributesW(nativeName); if (result == 0xffffffff) { StatError(interp, fileName); @@ -1636,10 +1636,10 @@ ConvertFileNameFormat( Tcl_Obj *tempPath; Tcl_DString ds; Tcl_DString dsTemp; - const TCHAR *nativeName; + const WCHAR *nativeName; const char *tempString; int tempLen; - WIN32_FIND_DATA data; + WIN32_FIND_DATAW data; HANDLE handle; DWORD attr; @@ -1653,18 +1653,18 @@ ConvertFileNameFormat( Tcl_DStringInit(&ds); tempString = Tcl_GetStringFromObj(tempPath,&tempLen); - nativeName = Tcl_WinUtfToTChar(tempString, tempLen, &ds); + nativeName = (WCHAR *)Tcl_WinUtfToTChar(tempString, tempLen, &ds); Tcl_DecrRefCount(tempPath); - handle = FindFirstFile(nativeName, &data); + handle = FindFirstFileW(nativeName, &data); if (handle == INVALID_HANDLE_VALUE) { /* - * FindFirstFile() doesn't like root directories. We would + * FindFirstFileW() doesn't like root directories. We would * only get a root directory here if the caller specified "c:" * or "c:." and the current directory on the drive was the * root directory */ - attr = GetFileAttributes(nativeName); + attr = GetFileAttributesW(nativeName); if ((attr!=0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) { Tcl_DStringFree(&ds); goto simple; @@ -1685,7 +1685,7 @@ ConvertFileNameFormat( } } else { if (data.cAlternateFileName[0] == '\0') { - nativeName = (TCHAR *) data.cFileName; + nativeName = (WCHAR *) data.cFileName; } } @@ -1702,7 +1702,7 @@ ConvertFileNameFormat( */ Tcl_DStringInit(&dsTemp); - Tcl_WinTCharToUtf(nativeName, -1, &dsTemp); + Tcl_WinTCharToUtf((TCHAR *)nativeName, -1, &dsTemp); Tcl_DStringFree(&ds); /* @@ -1831,10 +1831,10 @@ SetWinFileAttributes( { DWORD fileAttributes, old; int yesNo, result; - const TCHAR *nativeName; + const WCHAR *nativeName; nativeName = Tcl_FSGetNativePath(fileName); - fileAttributes = old = GetFileAttributes(nativeName); + fileAttributes = old = GetFileAttributesW(nativeName); if (fileAttributes == 0xffffffff) { StatError(interp, fileName); @@ -1853,7 +1853,7 @@ SetWinFileAttributes( } if ((fileAttributes != old) - && !SetFileAttributes(nativeName, fileAttributes)) { + && !SetFileAttributesW(nativeName, fileAttributes)) { StatError(interp, fileName); return TCL_ERROR; } @@ -1926,10 +1926,10 @@ TclpObjListVolumes(void) if (GetLogicalDriveStringsA(sizeof(buf), buf) == 0) { /* - * GetVolumeInformation() will detects all drives, but causes + * GetVolumeInformationW() will detect all drives, but causes * chattering on empty floppy drives. We only do this if * GetLogicalDriveStrings() didn't work. It has also been reported - * that on some laptops it takes a while for GetVolumeInformation() to + * that on some laptops it takes a while for GetVolumeInformationW() to * return when pinging an empty floppy drive, another reason to try to * avoid calling it. */ diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 2f35d4a..bda0592 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -156,27 +156,27 @@ static void FromCTime(time_t posixTime, FILETIME *fileTime); * Declarations for local functions defined in this file: */ -static int NativeAccess(const TCHAR *path, int mode); -static int NativeDev(const TCHAR *path); -static int NativeStat(const TCHAR *path, Tcl_StatBuf *statPtr, +static int NativeAccess(const WCHAR *path, int mode); +static int NativeDev(const WCHAR *path); +static int NativeStat(const WCHAR *path, Tcl_StatBuf *statPtr, int checkLinks); static unsigned short NativeStatMode(DWORD attr, int checkLinks, int isExec); -static int NativeIsExec(const TCHAR *path); -static int NativeReadReparse(const TCHAR *LinkDirectory, +static int NativeIsExec(const WCHAR *path); +static int NativeReadReparse(const WCHAR *LinkDirectory, REPARSE_DATA_BUFFER *buffer, DWORD desiredAccess); -static int NativeWriteReparse(const TCHAR *LinkDirectory, +static int NativeWriteReparse(const WCHAR *LinkDirectory, REPARSE_DATA_BUFFER *buffer); static int NativeMatchType(int isDrive, DWORD attr, - const TCHAR *nativeName, Tcl_GlobTypeData *types); + const WCHAR *nativeName, Tcl_GlobTypeData *types); static int WinIsDrive(const char *name, int nameLen); static int WinIsReserved(const char *path); -static Tcl_Obj * WinReadLink(const TCHAR *LinkSource); -static Tcl_Obj * WinReadLinkDirectory(const TCHAR *LinkDirectory); -static int WinLink(const TCHAR *LinkSource, - const TCHAR *LinkTarget, int linkAction); -static int WinSymLinkDirectory(const TCHAR *LinkDirectory, - const TCHAR *LinkTarget); +static Tcl_Obj * WinReadLink(const WCHAR *LinkSource); +static Tcl_Obj * WinReadLinkDirectory(const WCHAR *LinkDirectory); +static int WinLink(const WCHAR *LinkSource, + const WCHAR *LinkTarget, int linkAction); +static int WinSymLinkDirectory(const WCHAR *LinkDirectory, + const WCHAR *LinkTarget); MODULE_SCOPE TCL_NORETURN void tclWinDebugPanic(const char *format, ...); /* @@ -191,19 +191,19 @@ MODULE_SCOPE TCL_NORETURN void tclWinDebugPanic(const char *format, ...); static int WinLink( - const TCHAR *linkSourcePath, - const TCHAR *linkTargetPath, + const WCHAR *linkSourcePath, + const WCHAR *linkTargetPath, int linkAction) { - TCHAR tempFileName[MAX_PATH]; - TCHAR *tempFilePart; + WCHAR tempFileName[MAX_PATH]; + WCHAR *tempFilePart; DWORD attr; /* * Get the full path referenced by the target. */ - if (!GetFullPathName(linkTargetPath, MAX_PATH, tempFileName, + if (!GetFullPathNameW(linkTargetPath, MAX_PATH, tempFileName, &tempFilePart)) { /* * Invalid file. @@ -217,7 +217,7 @@ WinLink( * Make sure source file doesn't exist. */ - attr = GetFileAttributes(linkSourcePath); + attr = GetFileAttributesW(linkSourcePath); if (attr != INVALID_FILE_ATTRIBUTES) { Tcl_SetErrno(EEXIST); return -1; @@ -227,7 +227,7 @@ WinLink( * Get the full path referenced by the source file/directory. */ - if (!GetFullPathName(linkSourcePath, MAX_PATH, tempFileName, + if (!GetFullPathNameW(linkSourcePath, MAX_PATH, tempFileName, &tempFilePart)) { /* * Invalid file. @@ -241,7 +241,7 @@ WinLink( * Check the target. */ - attr = GetFileAttributes(linkTargetPath); + attr = GetFileAttributesW(linkTargetPath); if (attr == INVALID_FILE_ATTRIBUTES) { /* * The target doesn't exist. @@ -254,7 +254,7 @@ WinLink( */ if (linkAction & TCL_CREATE_HARD_LINK) { - if (CreateHardLink(linkSourcePath, linkTargetPath, NULL)) { + if (CreateHardLinkW(linkSourcePath, linkTargetPath, NULL)) { /* * Success! */ @@ -306,17 +306,17 @@ WinLink( static Tcl_Obj * WinReadLink( - const TCHAR *linkSourcePath) + const WCHAR *linkSourcePath) { - TCHAR tempFileName[MAX_PATH]; - TCHAR *tempFilePart; + WCHAR tempFileName[MAX_PATH]; + WCHAR *tempFilePart; DWORD attr; /* * Get the full path referenced by the target. */ - if (!GetFullPathName(linkSourcePath, MAX_PATH, tempFileName, + if (!GetFullPathNameW(linkSourcePath, MAX_PATH, tempFileName, &tempFilePart)) { /* * Invalid file. @@ -330,7 +330,7 @@ WinReadLink( * Make sure source file does exist. */ - attr = GetFileAttributes(linkSourcePath); + attr = GetFileAttributesW(linkSourcePath); if (attr == INVALID_FILE_ATTRIBUTES) { /* * The source doesn't exist. @@ -370,8 +370,8 @@ WinReadLink( static int WinSymLinkDirectory( - const TCHAR *linkDirPath, - const TCHAR *linkTargetPath) + const WCHAR *linkDirPath, + const WCHAR *linkTargetPath) { DUMMY_REPARSE_BUFFER dummy; REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER *) &dummy; @@ -442,8 +442,8 @@ WinSymLinkDirectory( int TclWinSymLinkCopyDirectory( - const TCHAR *linkOrigPath, /* Existing junction - reparse point */ - const TCHAR *linkCopyPath) /* Will become a duplicate junction */ + const WCHAR *linkOrigPath, /* Existing junction - reparse point */ + const WCHAR *linkCopyPath) /* Will become a duplicate junction */ { DUMMY_REPARSE_BUFFER dummy; REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER *) &dummy; @@ -473,7 +473,7 @@ TclWinSymLinkCopyDirectory( int TclWinSymLinkDelete( - const TCHAR *linkOrigPath, + const WCHAR *linkOrigPath, int linkOnly) { /* @@ -487,7 +487,7 @@ TclWinSymLinkDelete( memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER)); reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT; - hFile = CreateFile(linkOrigPath, GENERIC_WRITE, 0, NULL, OPEN_EXISTING, + hFile = CreateFileW(linkOrigPath, GENERIC_WRITE, 0, NULL, OPEN_EXISTING, FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL); if (hFile != INVALID_HANDLE_VALUE) { @@ -502,7 +502,7 @@ TclWinSymLinkDelete( } else { CloseHandle(hFile); if (!linkOnly) { - RemoveDirectory(linkOrigPath); + RemoveDirectoryW(linkOrigPath); } return 0; } @@ -538,7 +538,7 @@ TclWinSymLinkDelete( static Tcl_Obj * WinReadLinkDirectory( - const TCHAR *linkDirPath) + const WCHAR *linkDirPath) { int attr, len, offset; DUMMY_REPARSE_BUFFER dummy; @@ -547,7 +547,7 @@ WinReadLinkDirectory( Tcl_DString ds; const char *copy; - attr = GetFileAttributes(linkDirPath); + attr = GetFileAttributesW(linkDirPath); if (!(attr & FILE_ATTRIBUTE_REPARSE_POINT)) { goto invalidError; } @@ -636,7 +636,7 @@ WinReadLinkDirectory( } #endif /* UNICODE */ - Tcl_WinTCharToUtf((const TCHAR *) + Tcl_WinTCharToUtf((TCHAR *) reparseBuffer->MountPointReparseBuffer.PathBuffer, (int) reparseBuffer->MountPointReparseBuffer .SubstituteNameLength, &ds); @@ -675,14 +675,14 @@ WinReadLinkDirectory( static int NativeReadReparse( - const TCHAR *linkDirPath, /* The junction to read */ + const WCHAR *linkDirPath, /* The junction to read */ REPARSE_DATA_BUFFER *buffer,/* Pointer to buffer. Cannot be NULL */ DWORD desiredAccess) { HANDLE hFile; DWORD returnedLength; - hFile = CreateFile(linkDirPath, desiredAccess, FILE_SHARE_READ, NULL, + hFile = CreateFileW(linkDirPath, desiredAccess, FILE_SHARE_READ, NULL, OPEN_EXISTING, FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL); @@ -732,7 +732,7 @@ NativeReadReparse( static int NativeWriteReparse( - const TCHAR *linkDirPath, + const WCHAR *linkDirPath, REPARSE_DATA_BUFFER *buffer) { HANDLE hFile; @@ -742,7 +742,7 @@ NativeWriteReparse( * Create the directory - it must not already exist. */ - if (CreateDirectory(linkDirPath, NULL) == 0) { + if (CreateDirectoryW(linkDirPath, NULL) == 0) { /* * Error creating directory. */ @@ -750,7 +750,7 @@ NativeWriteReparse( TclWinConvertError(GetLastError()); return -1; } - hFile = CreateFile(linkDirPath, GENERIC_WRITE, 0, NULL, + hFile = CreateFileW(linkDirPath, GENERIC_WRITE, 0, NULL, OPEN_EXISTING, FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL); if (hFile == INVALID_HANDLE_VALUE) { @@ -775,7 +775,7 @@ NativeWriteReparse( TclWinConvertError(GetLastError()); CloseHandle(hFile); - RemoveDirectory(linkDirPath); + RemoveDirectoryW(linkDirPath); return -1; } CloseHandle(hFile); @@ -925,7 +925,7 @@ TclpMatchInDirectory( * May be NULL. In particular the directory * flag is very important. */ { - const TCHAR *native; + const WCHAR *native; if (types != NULL && types->type == TCL_GLOB_TYPE_MOUNT) { /* @@ -950,7 +950,7 @@ TclpMatchInDirectory( native = Tcl_FSGetNativePath(pathPtr); - if (GetFileAttributesEx(native, + if (GetFileAttributesExW(native, GetFileExInfoStandard, &data) != TRUE) { return TCL_OK; } @@ -964,7 +964,7 @@ TclpMatchInDirectory( } else { DWORD attr; HANDLE handle; - WIN32_FIND_DATA data; + WIN32_FIND_DATAW data; const char *dirName; /* UTF-8 dir name, later with pattern * appended. */ int dirLength; @@ -993,7 +993,7 @@ TclpMatchInDirectory( if (native == NULL) { return TCL_OK; } - attr = GetFileAttributes(native); + attr = GetFileAttributesW(native); if ((attr == INVALID_FILE_ATTRIBUTES) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) { @@ -1034,15 +1034,15 @@ TclpMatchInDirectory( dirName = TclDStringAppendLiteral(&dsOrig, "*.*"); } - native = Tcl_WinUtfToTChar(dirName, -1, &ds); + native = (WCHAR *)Tcl_WinUtfToTChar(dirName, -1, &ds); if ((types == NULL) || (types->type != TCL_GLOB_TYPE_DIR)) { - handle = FindFirstFile(native, &data); + handle = FindFirstFileW(native, &data); } else { /* * We can be more efficient, for pure directory requests. */ - handle = FindFirstFileEx(native, + handle = FindFirstFileExW(native, FindExInfoStandard, &data, FindExSearchLimitToDirectories, NULL, 0); } @@ -1107,7 +1107,7 @@ TclpMatchInDirectory( native = data.cFileName; attr = data.dwFileAttributes; - utfname = Tcl_WinTCharToUtf(native, -1, &ds); + utfname = Tcl_WinTCharToUtf((TCHAR *)native, -1, &ds); if (!matchSpecialDots) { /* @@ -1167,7 +1167,7 @@ TclpMatchInDirectory( */ Tcl_DStringFree(&ds); - } while (FindNextFile(handle, &data) == TRUE); + } while (FindNextFileW(handle, &data) == TRUE); FindClose(handle); Tcl_DStringFree(&dsOrig); @@ -1325,7 +1325,7 @@ NativeMatchType( int isDrive, /* Is this a drive. */ DWORD attr, /* We already know the attributes for the * file. */ - const TCHAR *nativeName, /* Native path to check. */ + const WCHAR *nativeName, /* Native path to check. */ Tcl_GlobTypeData *types) /* Type description to match against. */ { /* @@ -1596,12 +1596,12 @@ TclpGetUserHome( static int NativeAccess( - const TCHAR *nativePath, /* Path of file to access, native encoding. */ + const WCHAR *nativePath, /* Path of file to access, native encoding. */ int mode) /* Permission setting. */ { DWORD attr; - attr = GetFileAttributes(nativePath); + attr = GetFileAttributesW(nativePath); if (attr == INVALID_FILE_ATTRIBUTES) { /* @@ -1670,7 +1670,7 @@ NativeAccess( mask |= GENERIC_EXECUTE; } - hFile = CreateFile(nativePath, mask, + hFile = CreateFileW(nativePath, mask, FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, NULL, OPEN_EXISTING, FILE_FLAG_NO_BUFFERING, NULL); if (hFile != INVALID_HANDLE_VALUE) { @@ -1884,9 +1884,9 @@ NativeAccess( static int NativeIsExec( - const TCHAR *path) + const WCHAR *path) { - int len = _tcslen(path); + size_t len = wcslen(path); if (len < 5) { return 0; @@ -1897,11 +1897,11 @@ NativeIsExec( } path += len-3; - if ((_tcsicmp(path, TEXT("exe")) == 0) - || (_tcsicmp(path, TEXT("com")) == 0) - || (_tcsicmp(path, TEXT("cmd")) == 0) - || (_tcsicmp(path, TEXT("cmd")) == 0) - || (_tcsicmp(path, TEXT("bat")) == 0)) { + if ((wcsicmp(path, L"exe") == 0) + || (wcsicmp(path, L"com") == 0) + || (wcsicmp(path, L"cmd") == 0) + || (wcsicmp(path, L"cmd") == 0) + || (wcsicmp(path, L"bat") == 0)) { return 1; } return 0; @@ -1928,14 +1928,14 @@ TclpObjChdir( Tcl_Obj *pathPtr) /* Path to new working directory. */ { int result; - const TCHAR *nativePath; + const WCHAR *nativePath; nativePath = Tcl_FSGetNativePath(pathPtr); if (!nativePath) { return -1; } - result = SetCurrentDirectory(nativePath); + result = SetCurrentDirectoryW(nativePath); if (result == 0) { TclWinConvertError(GetLastError()); @@ -1972,11 +1972,11 @@ TclpGetCwd( Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with * name of current directory. */ { - TCHAR buffer[MAX_PATH]; + WCHAR buffer[MAX_PATH]; char *p; WCHAR *native; - if (GetCurrentDirectory(MAX_PATH, buffer) == 0) { + if (GetCurrentDirectoryW(MAX_PATH, buffer) == 0) { TclWinConvertError(GetLastError()); if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -2050,7 +2050,7 @@ TclpObjStat( static int NativeStat( - const TCHAR *nativePath, /* Path of file to stat */ + const WCHAR *nativePath, /* Path of file to stat */ Tcl_StatBuf *statPtr, /* Filled with results of stat call. */ int checkLinks) /* If non-zero, behave like 'lstat' */ { @@ -2076,7 +2076,7 @@ NativeStat( * and if successful, mock up a BY_HANDLE_FILE_INFORMATION structure. */ - fileHandle = CreateFile(nativePath, GENERIC_READ, + fileHandle = CreateFileW(nativePath, GENERIC_READ, FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, NULL, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS | FILE_FLAG_OPEN_REPARSE_POINT, NULL); @@ -2134,17 +2134,17 @@ NativeStat( WIN32_FILE_ATTRIBUTE_DATA data; - if (GetFileAttributesEx(nativePath, + if (GetFileAttributesExW(nativePath, GetFileExInfoStandard, &data) != TRUE) { HANDLE hFind; - WIN32_FIND_DATA ffd; + WIN32_FIND_DATAW ffd; DWORD lasterror = GetLastError(); if (lasterror != ERROR_SHARING_VIOLATION) { TclWinConvertError(lasterror); return -1; } - hFind = FindFirstFile(nativePath, &ffd); + hFind = FindFirstFileW(nativePath, &ffd); if (hFind == INVALID_HANDLE_VALUE) { TclWinConvertError(GetLastError()); return -1; @@ -2194,28 +2194,28 @@ NativeStat( static int NativeDev( - const TCHAR *nativePath) /* Full path of file to stat */ + const WCHAR *nativePath) /* Full path of file to stat */ { int dev; Tcl_DString ds; - TCHAR nativeFullPath[MAX_PATH]; - TCHAR *nativePart; + WCHAR nativeFullPath[MAX_PATH]; + WCHAR *nativePart; const char *fullPath; - GetFullPathName(nativePath, MAX_PATH, nativeFullPath, &nativePart); - fullPath = Tcl_WinTCharToUtf(nativeFullPath, -1, &ds); + GetFullPathNameW(nativePath, MAX_PATH, nativeFullPath, &nativePart); + fullPath = Tcl_WinTCharToUtf((TCHAR *)nativeFullPath, -1, &ds); if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) { const char *p; DWORD dw; - const TCHAR *nativeVol; + const WCHAR *nativeVol; Tcl_DString volString; p = strchr(fullPath + 2, '\\'); p = strchr(p + 1, '\\'); if (p == NULL) { /* - * Add terminating backslash to fullpath or GetVolumeInformation() + * Add terminating backslash to fullpath or GetVolumeInformationW() * won't work. */ @@ -2224,13 +2224,13 @@ NativeDev( } else { p++; } - nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString); + nativeVol = (WCHAR *)Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString); dw = (DWORD) -1; - GetVolumeInformation(nativeVol, NULL, 0, &dw, NULL, NULL, NULL, 0); + GetVolumeInformationW(nativeVol, NULL, 0, &dw, NULL, NULL, NULL, 0); /* - * GetFullPathName() turns special devices like "NUL" into "\\.\NUL", - * but GetVolumeInformation() returns failure for "\\.\NUL". This will + * GetFullPathNameW() turns special devices like "NUL" into "\\.\NUL", + * but GetVolumeInformationW() returns failure for "\\.\NUL". This will * cause "NUL" to get a drive number of -1, which makes about as much * sense as anything since the special devices don't live on any * drive. @@ -2370,15 +2370,15 @@ ClientData TclpGetNativeCwd( ClientData clientData) { - TCHAR buffer[MAX_PATH]; + WCHAR buffer[MAX_PATH]; - if (GetCurrentDirectory(MAX_PATH, buffer) == 0) { + if (GetCurrentDirectoryW(MAX_PATH, buffer) == 0) { TclWinConvertError(GetLastError()); return NULL; } if (clientData != NULL) { - if (_tcscmp((const TCHAR *) clientData, buffer) == 0) { + if (wcscmp((const WCHAR *) clientData, buffer) == 0) { return clientData; } } @@ -2419,8 +2419,8 @@ TclpObjLink( { if (toPtr != NULL) { int res; - const TCHAR *LinkTarget; - const TCHAR *LinkSource = Tcl_FSGetNativePath(pathPtr); + const WCHAR *LinkTarget; + const WCHAR *LinkSource = Tcl_FSGetNativePath(pathPtr); Tcl_Obj *normalizedToPtr = Tcl_FSGetNormalizedPath(NULL, toPtr); if (normalizedToPtr == NULL) { @@ -2439,7 +2439,7 @@ TclpObjLink( return NULL; } } else { - const TCHAR *LinkSource = Tcl_FSGetNativePath(pathPtr); + const WCHAR *LinkSource = Tcl_FSGetNativePath(pathPtr); if (LinkSource == NULL) { return NULL; @@ -2473,7 +2473,7 @@ TclpFilesystemPathType( { #define VOL_BUF_SIZE 32 int found; - TCHAR volType[VOL_BUF_SIZE]; + WCHAR volType[VOL_BUF_SIZE]; char *firstSeparator; const char *path; Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr); @@ -2488,13 +2488,13 @@ TclpFilesystemPathType( firstSeparator = strchr(path, '/'); if (firstSeparator == NULL) { - found = GetVolumeInformation(Tcl_FSGetNativePath(pathPtr), + found = GetVolumeInformationW(Tcl_FSGetNativePath(pathPtr), NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE); } else { Tcl_Obj *driveName = Tcl_NewStringObj(path, firstSeparator - path+1); Tcl_IncrRefCount(driveName); - found = GetVolumeInformation(Tcl_FSGetNativePath(driveName), + found = GetVolumeInformationW(Tcl_FSGetNativePath(driveName), NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE); Tcl_DecrRefCount(driveName); } @@ -2504,7 +2504,7 @@ TclpFilesystemPathType( } else { Tcl_DString ds; - Tcl_WinTCharToUtf(volType, -1, &ds); + Tcl_WinTCharToUtf((TCHAR *)volType, -1, &ds); return TclDStringToObj(&ds); } #undef VOL_BUF_SIZE @@ -2574,10 +2574,10 @@ TclpObjNormalizePath( */ WIN32_FILE_ATTRIBUTE_DATA data; - const TCHAR *nativePath = Tcl_WinUtfToTChar(path, + const WCHAR *nativePath = (WCHAR *)Tcl_WinUtfToTChar(path, currentPathEndPosition - path, &ds); - if (GetFileAttributesEx(nativePath, + if (GetFileAttributesExW(nativePath, GetFileExInfoStandard, &data) != TRUE) { /* * File doesn't exist. @@ -2718,8 +2718,8 @@ TclpObjNormalizePath( Tcl_DStringAppend(&dsNorm, ((const char *)nativePath) + Tcl_DStringLength(&ds) - - (dotLen * sizeof(TCHAR)), - (int)(dotLen * sizeof(TCHAR))); + - (dotLen * sizeof(WCHAR)), + (int)(dotLen * sizeof(WCHAR))); } else { /* * Normal path. @@ -2776,10 +2776,10 @@ TclpObjNormalizePath( if (1) { WCHAR wpath[MAX_PATH]; - const TCHAR *nativePath = + const WCHAR *nativePath = Tcl_WinUtfToTChar(path, lastValidPathEnd - path, &ds); DWORD wpathlen = GetLongPathNameProc(nativePath, - (TCHAR *) wpath, MAX_PATH); + (WCHAR *) wpath, MAX_PATH); /* * We have to make the drive letter uppercase. @@ -2807,7 +2807,7 @@ TclpObjNormalizePath( * native encoding, so we have to convert it to Utf. */ - Tcl_WinTCharToUtf((const TCHAR *) Tcl_DStringValue(&dsNorm), + Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&dsNorm), Tcl_DStringLength(&dsNorm), &ds); nextCheckpoint = Tcl_DStringLength(&ds); if (*lastValidPathEnd != 0) { @@ -2984,7 +2984,7 @@ TclpNativeToNormalized( int len; char *copy, *p; - Tcl_WinTCharToUtf((const TCHAR *) clientData, -1, &ds); + Tcl_WinTCharToUtf((TCHAR *) clientData, -1, &ds); copy = Tcl_DStringValue(&ds); len = Tcl_DStringLength(&ds); @@ -3208,7 +3208,7 @@ TclNativeDupInternalRep( return NULL; } - len = sizeof(TCHAR) * (_tcslen((const TCHAR *) clientData) + 1); + len = sizeof(WCHAR) * (wcslen((const WCHAR *) clientData) + 1); copy = ckalloc(len); memcpy(copy, clientData, len); @@ -3239,7 +3239,7 @@ TclpUtime( { int res = 0; HANDLE fileHandle; - const TCHAR *native; + const WCHAR *native; DWORD attr = 0; DWORD flags = FILE_ATTRIBUTE_NORMAL; FILETIME lastAccessTime, lastModTime; @@ -3249,7 +3249,7 @@ TclpUtime( native = Tcl_FSGetNativePath(pathPtr); - attr = GetFileAttributes(native); + attr = GetFileAttributesW(native); if (attr != INVALID_FILE_ATTRIBUTES && attr & FILE_ATTRIBUTE_DIRECTORY) { flags = FILE_FLAG_BACKUP_SEMANTICS; @@ -3260,7 +3260,7 @@ TclpUtime( * savings complications that utime gets wrong. */ - fileHandle = CreateFile(native, FILE_WRITE_ATTRIBUTES, 0, NULL, + fileHandle = CreateFileW(native, FILE_WRITE_ATTRIBUTES, 0, NULL, OPEN_EXISTING, flags, NULL); if (fileHandle == INVALID_HANDLE_VALUE || @@ -3290,7 +3290,7 @@ int TclWinFileOwned( Tcl_Obj *pathPtr) /* File whose ownership is to be checked */ { - const TCHAR *native; + const WCHAR *native; PSID ownerSid = NULL; PSECURITY_DESCRIPTOR secd = NULL; HANDLE token; diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 0574c37..afa6bf4 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -17,7 +17,7 @@ #include /* - * GetUserName() is found in advapi32.dll + * GetUserNameW() is found in advapi32.dll */ #ifdef _MSC_VER # pragma comment(lib, "advapi32.lib") @@ -166,7 +166,7 @@ TclpInitPlatform(void) /* * Fill available functions depending on windows version */ - handle = GetModuleHandle(TEXT("KERNEL32")); + handle = GetModuleHandleW(L"KERNEL32"); tclWinProcs.cancelSynchronousIo = (BOOL (WINAPI *)(HANDLE)) GetProcAddress(handle, "CancelSynchronousIo"); @@ -525,15 +525,15 @@ TclpGetUserName( Tcl_DStringInit(bufferPtr); if (TclGetEnv("USERNAME", bufferPtr) == NULL) { - TCHAR szUserName[UNLEN+1]; + WCHAR szUserName[UNLEN+1]; DWORD cchUserNameLen = UNLEN; - if (!GetUserName(szUserName, &cchUserNameLen)) { + if (!GetUserNameW(szUserName, &cchUserNameLen)) { return NULL; } cchUserNameLen--; - cchUserNameLen *= sizeof(TCHAR); - Tcl_WinTCharToUtf(szUserName, cchUserNameLen, bufferPtr); + cchUserNameLen *= sizeof(WCHAR); + Tcl_WinTCharToUtf((TCHAR *)szUserName, cchUserNameLen, bufferPtr); } return Tcl_DStringValue(bufferPtr); } @@ -573,7 +573,7 @@ TclpSetVariables( TclGetProcessGlobalValue(&defaultLibraryDir), TCL_GLOBAL_ONLY); if (!osInfoInitialized) { - HMODULE handle = GetModuleHandle(TEXT("NTDLL")); + HMODULE handle = GetModuleHandleW(L"NTDLL"); int(__stdcall *getversion)(void *) = (int(__stdcall *)(void *)) GetProcAddress(handle, "RtlGetVersion"); osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW); diff --git a/win/tclWinInt.h b/win/tclWinInt.h index d0844da..ed99ad0 100644 --- a/win/tclWinInt.h +++ b/win/tclWinInt.h @@ -65,7 +65,7 @@ MODULE_SCOPE TclWinProcs tclWinProcs; */ MODULE_SCOPE char TclWinDriveLetterForVolMountPoint( - const TCHAR *mountPoint); + const WCHAR *mountPoint); MODULE_SCOPE void TclWinEncodingsCleanup(); MODULE_SCOPE void TclWinInit(HINSTANCE hInst); MODULE_SCOPE TclFile TclWinMakeFile(HANDLE handle); @@ -75,11 +75,11 @@ MODULE_SCOPE Tcl_Channel TclWinOpenFileChannel(HANDLE handle, char *channelName, int permissions, int appendMode); MODULE_SCOPE Tcl_Channel TclWinOpenSerialChannel(HANDLE handle, char *channelName, int permissions); -MODULE_SCOPE HANDLE TclWinSerialOpen(HANDLE handle, const TCHAR *name, +MODULE_SCOPE HANDLE TclWinSerialOpen(HANDLE handle, const WCHAR *name, DWORD access); -MODULE_SCOPE int TclWinSymLinkCopyDirectory(const TCHAR *LinkOriginal, - const TCHAR *LinkCopy); -MODULE_SCOPE int TclWinSymLinkDelete(const TCHAR *LinkOriginal, +MODULE_SCOPE int TclWinSymLinkCopyDirectory(const WCHAR *LinkOriginal, + const WCHAR *LinkCopy); +MODULE_SCOPE int TclWinSymLinkDelete(const WCHAR *LinkOriginal, int linkOnly); MODULE_SCOPE int TclWinFileOwned(Tcl_Obj *); #if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c index 69263e9..89adcc3 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.c @@ -64,7 +64,7 @@ TclpDlopen( int flags) { HINSTANCE hInstance = NULL; - const TCHAR *nativeName; + const WCHAR *nativeName; Tcl_LoadHandle handlePtr; DWORD firstError; @@ -76,7 +76,7 @@ TclpDlopen( nativeName = Tcl_FSGetNativePath(pathPtr); if (nativeName != NULL) { - hInstance = LoadLibraryEx(nativeName, NULL, + hInstance = LoadLibraryExW(nativeName, NULL, LOAD_WITH_ALTERED_SEARCH_PATH); } if (hInstance == NULL) { @@ -95,8 +95,8 @@ TclpDlopen( firstError = (nativeName == NULL) ? ERROR_MOD_NOT_FOUND : GetLastError(); - nativeName = Tcl_WinUtfToTChar(Tcl_GetString(pathPtr), -1, &ds); - hInstance = LoadLibraryEx(nativeName, NULL, + nativeName = (WCHAR *)Tcl_WinUtfToTChar(Tcl_GetString(pathPtr), -1, &ds); + hInstance = LoadLibraryExW(nativeName, NULL, LOAD_WITH_ALTERED_SEARCH_PATH); Tcl_DStringFree(&ds); } diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c index 4543b02..bb0eb18 100644 --- a/win/tclWinNotify.c +++ b/win/tclWinNotify.c @@ -50,7 +50,7 @@ static Tcl_ThreadDataKey dataKey; */ static int notifierCount = 0; -static const TCHAR classname[] = TEXT("TclNotifier"); +static const WCHAR classname[] = L"TclNotifier"; TCL_DECLARE_MUTEX(notifierMutex) /* @@ -83,7 +83,7 @@ Tcl_InitNotifier(void) return tclNotifierHooks.initNotifierProc(); } else { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - WNDCLASS class; + WNDCLASSW windowClass; /* * Register Notifier window class if this is the first thread to use @@ -92,18 +92,18 @@ Tcl_InitNotifier(void) Tcl_MutexLock(¬ifierMutex); if (notifierCount == 0) { - class.style = 0; - class.cbClsExtra = 0; - class.cbWndExtra = 0; - class.hInstance = TclWinGetTclInstance(); - class.hbrBackground = NULL; - class.lpszMenuName = NULL; - class.lpszClassName = classname; - class.lpfnWndProc = NotifierProc; - class.hIcon = NULL; - class.hCursor = NULL; - - if (!RegisterClass(&class)) { + windowClass.style = 0; + windowClass.cbClsExtra = 0; + windowClass.cbWndExtra = 0; + windowClass.hInstance = TclWinGetTclInstance(); + windowClass.hbrBackground = NULL; + windowClass.lpszMenuName = NULL; + windowClass.lpszClassName = classname; + windowClass.lpfnWndProc = NotifierProc; + windowClass.hIcon = NULL; + windowClass.hCursor = NULL; + + if (!RegisterClassW(&windowClass)) { Tcl_Panic("Unable to register TclNotifier window class"); } } @@ -186,7 +186,7 @@ Tcl_FinalizeNotifier( Tcl_MutexLock(¬ifierMutex); notifierCount--; if (notifierCount == 0) { - UnregisterClass(classname, TclWinGetTclInstance()); + UnregisterClassW(classname, TclWinGetTclInstance()); } Tcl_MutexUnlock(¬ifierMutex); } @@ -350,7 +350,7 @@ Tcl_ServiceModeHook( */ if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) { - tsdPtr->hwnd = CreateWindow(classname, classname, + tsdPtr->hwnd = CreateWindowW(classname, classname, WS_TILED, 0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(), NULL); diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index d8e96d5..4399b71 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -190,7 +190,7 @@ static DWORD WINAPI PipeReaderThread(LPVOID arg); static void PipeSetupProc(ClientData clientData, int flags); static void PipeWatchProc(ClientData instanceData, int mask); static DWORD WINAPI PipeWriterThread(LPVOID arg); -static int TempFileName(TCHAR name[MAX_PATH]); +static int TempFileName(WCHAR name[MAX_PATH]); static int WaitForRead(PipeInfo *infoPtr, int blocking); static void PipeThreadActionProc(ClientData instanceData, int action); @@ -462,18 +462,18 @@ TclWinMakeFile( static int TempFileName( - TCHAR name[MAX_PATH]) /* Buffer in which name for temporary file + WCHAR name[MAX_PATH]) /* Buffer in which name for temporary file * gets stored. */ { - const TCHAR *prefix = TEXT("TCL"); - if (GetTempPath(MAX_PATH, name) != 0) { - if (GetTempFileName(name, prefix, 0, name) != 0) { + const WCHAR *prefix = L"TCL"; + if (GetTempPathW(MAX_PATH, name) != 0) { + if (GetTempFileNameW(name, prefix, 0, name) != 0) { return 1; } } name[0] = '.'; name[1] = '\0'; - return GetTempFileName(name, prefix, 0, name); + return GetTempFileNameW(name, prefix, 0, name); } /* @@ -532,7 +532,7 @@ TclpOpenFile( HANDLE handle; DWORD accessMode, createMode, shareMode, flags; Tcl_DString ds; - const TCHAR *nativePath; + const WCHAR *nativePath; /* * Map the access bits to the NT access mode. @@ -577,7 +577,7 @@ TclpOpenFile( break; } - nativePath = Tcl_WinUtfToTChar(path, -1, &ds); + nativePath = (WCHAR *)Tcl_WinUtfToTChar(path, -1, &ds); /* * If the file is not being created, use the existing file attributes. @@ -585,7 +585,7 @@ TclpOpenFile( flags = 0; if (!(mode & O_CREAT)) { - flags = GetFileAttributes(nativePath); + flags = GetFileAttributesW(nativePath); if (flags == 0xFFFFFFFF) { flags = 0; } @@ -601,7 +601,7 @@ TclpOpenFile( * Now we get to create the file. */ - handle = CreateFile(nativePath, accessMode, shareMode, + handle = CreateFileW(nativePath, accessMode, shareMode, NULL, createMode, flags, NULL); Tcl_DStringFree(&ds); @@ -649,7 +649,7 @@ TclFile TclpCreateTempFile( const char *contents) /* String to write into temp file, or NULL. */ { - TCHAR name[MAX_PATH]; + WCHAR name[MAX_PATH]; const char *native; Tcl_DString dstring; HANDLE handle; @@ -658,7 +658,7 @@ TclpCreateTempFile( return NULL; } - handle = CreateFile(name, + handle = CreateFileW(name, GENERIC_READ | GENERIC_WRITE, 0, NULL, CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY|FILE_FLAG_DELETE_ON_CLOSE, NULL); if (handle == INVALID_HANDLE_VALUE) { @@ -720,7 +720,7 @@ TclpCreateTempFile( TclWinConvertError(GetLastError()); CloseHandle(handle); - DeleteFile(name); + DeleteFileW(name); return NULL; } @@ -743,7 +743,7 @@ TclpCreateTempFile( Tcl_Obj * TclpTempFileName(void) { - TCHAR fileName[MAX_PATH]; + WCHAR fileName[MAX_PATH]; if (TempFileName(fileName) == 0) { return NULL; @@ -935,8 +935,8 @@ TclpCreateProcess( * process. */ { int result, applType, createFlags; - Tcl_DString cmdLine; /* Complete command line (TCHAR). */ - STARTUPINFO startInfo; + Tcl_DString cmdLine; /* Complete command line (WCHAR). */ + STARTUPINFOW startInfo; PROCESS_INFORMATION procInfo; SECURITY_ATTRIBUTES secAtts; HANDLE hProcess, h, inputHandle, outputHandle, errorHandle; @@ -1047,7 +1047,7 @@ TclpCreateProcess( * sink. */ - startInfo.hStdOutput = CreateFile(TEXT("NUL:"), GENERIC_WRITE, 0, + startInfo.hStdOutput = CreateFileW(L"NUL:", GENERIC_WRITE, 0, &secAtts, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL); } else { DuplicateHandle(hProcess, outputHandle, hProcess, @@ -1067,7 +1067,7 @@ TclpCreateProcess( * sink. */ - startInfo.hStdError = CreateFile(TEXT("NUL:"), GENERIC_WRITE, 0, + startInfo.hStdError = CreateFileW(L"NUL:", GENERIC_WRITE, 0, &secAtts, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); } else { DuplicateHandle(hProcess, errorHandle, hProcess, &startInfo.hStdError, @@ -1150,7 +1150,7 @@ TclpCreateProcess( BuildCommandLine(execPath, argc, argv, &cmdLine); - if (CreateProcess(NULL, (TCHAR *) Tcl_DStringValue(&cmdLine), + if (CreateProcessW(NULL, (WCHAR *) Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE, (DWORD) createFlags, NULL, NULL, &startInfo, &procInfo) == 0) { TclWinConvertError(GetLastError()); @@ -1276,14 +1276,14 @@ ApplicationType( { int applType, i, nameLen, found; HANDLE hFile; - TCHAR *rest; + WCHAR *rest; char *ext; char buf[2]; DWORD attr, read; IMAGE_DOS_HEADER header; Tcl_DString nameBuf, ds; - const TCHAR *nativeName; - TCHAR nativeFullPath[MAX_PATH]; + const WCHAR *nativeName; + WCHAR nativeFullPath[MAX_PATH]; static const char extensions[][5] = {"", ".com", ".exe", ".bat", ".cmd"}; /* @@ -1291,10 +1291,10 @@ ApplicationType( * is, then try adding .com, .exe, .bat and .cmd, in that order, to the name, * looking for an executable. * - * Using the raw SearchPath() function doesn't do quite what is necessary. + * Using the raw SearchPathW() function doesn't do quite what is necessary. * If the name of the executable already contains a '.' character, it will * not try appending the specified extension when searching (in other - * words, SearchPath will not find the program "a.b.exe" if the arguments + * words, SearchPathW will not find the program "a.b.exe" if the arguments * specified "a.b" and ".exe"). So, first look for the file as it is * named. Then manually append the extensions, looking for a match. */ @@ -1307,9 +1307,9 @@ ApplicationType( for (i = 0; i < (int) (sizeof(extensions) / sizeof(extensions[0])); i++) { Tcl_DStringSetLength(&nameBuf, nameLen); Tcl_DStringAppend(&nameBuf, extensions[i], -1); - nativeName = Tcl_WinUtfToTChar(Tcl_DStringValue(&nameBuf), + nativeName = (WCHAR *)Tcl_WinUtfToTChar(Tcl_DStringValue(&nameBuf), Tcl_DStringLength(&nameBuf), &ds); - found = SearchPath(NULL, nativeName, NULL, MAX_PATH, + found = SearchPathW(NULL, nativeName, NULL, MAX_PATH, nativeFullPath, &rest); Tcl_DStringFree(&ds); if (found == 0) { @@ -1321,11 +1321,11 @@ ApplicationType( * known type. */ - attr = GetFileAttributes(nativeFullPath); + attr = GetFileAttributesW(nativeFullPath); if ((attr == 0xffffffff) || (attr & FILE_ATTRIBUTE_DIRECTORY)) { continue; } - strcpy(fullName, Tcl_WinTCharToUtf(nativeFullPath, -1, &ds)); + strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *)nativeFullPath, -1, &ds)); Tcl_DStringFree(&ds); ext = strrchr(fullName, '.'); @@ -1335,7 +1335,7 @@ ApplicationType( break; } - hFile = CreateFile(nativeFullPath, + hFile = CreateFileW(nativeFullPath, GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); if (hFile == INVALID_HANDLE_VALUE) { @@ -1415,8 +1415,8 @@ ApplicationType( * application name from the arguments. */ - GetShortPathName(nativeFullPath, nativeFullPath, MAX_PATH); - strcpy(fullName, Tcl_WinTCharToUtf(nativeFullPath, -1, &ds)); + GetShortPathNameW(nativeFullPath, nativeFullPath, MAX_PATH); + strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *)nativeFullPath, -1, &ds)); Tcl_DStringFree(&ds); } return applType; @@ -1552,7 +1552,7 @@ BuildCommandLine( int argc, /* Number of arguments. */ const char **argv, /* Argument strings in UTF. */ Tcl_DString *linePtr) /* Initialized Tcl_DString that receives the - * command line (TCHAR). */ + * command line (WCHAR). */ { const char *arg, *start, *special, *bspos; int quote = 0, i; @@ -3206,7 +3206,7 @@ TclpOpenTemporaryFile( Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj) { - TCHAR name[MAX_PATH]; + WCHAR name[MAX_PATH]; char *namePtr; HANDLE handle; DWORD flags = FILE_ATTRIBUTE_TEMPORARY; @@ -3218,11 +3218,11 @@ TclpOpenTemporaryFile( } namePtr = (char *) name; - length = GetTempPath(MAX_PATH, name); + length = GetTempPathW(MAX_PATH, name); if (length == 0) { goto gotError; } - namePtr += length * sizeof(TCHAR); + namePtr += length * sizeof(WCHAR); if (basenameObj) { const char *string = Tcl_GetString(basenameObj); @@ -3231,8 +3231,8 @@ TclpOpenTemporaryFile( namePtr += Tcl_DStringLength(&buf); Tcl_DStringFree(&buf); } else { - const TCHAR *baseStr = TEXT("TCL"); - int length = 3 * sizeof(TCHAR); + const WCHAR *baseStr = L"TCL"; + int length = 3 * sizeof(WCHAR); memcpy(namePtr, baseStr, length); namePtr += length; @@ -3251,7 +3251,7 @@ TclpOpenTemporaryFile( memcpy(namePtr, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf) + 1); Tcl_DStringFree(&buf); - handle = CreateFile(name, + handle = CreateFileW(name, GENERIC_READ|GENERIC_WRITE, 0, NULL, CREATE_NEW, flags, NULL); } while (handle == INVALID_HANDLE_VALUE && --counter2 > 0 diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index fe416ff..8cf8b55 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -1368,7 +1368,7 @@ SerialWriterThread( HANDLE TclWinSerialOpen( HANDLE handle, - const TCHAR *name, + const WCHAR *name, DWORD access) { SerialInit(); @@ -1387,7 +1387,7 @@ TclWinSerialOpen( * finished */ - handle = CreateFile(name, access, 0, 0, OPEN_EXISTING, + handle = CreateFileW(name, access, 0, 0, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0); return handle; @@ -1595,7 +1595,7 @@ SerialSetOptionProc( BOOL result, flag; size_t len, vlen; Tcl_DString ds; - const TCHAR *native; + const WCHAR *native; int argc; const char **argv; @@ -1617,8 +1617,8 @@ SerialSetOptionProc( if (!GetCommState(infoPtr->handle, &dcb)) { goto getStateFailed; } - native = Tcl_WinUtfToTChar(value, -1, &ds); - result = BuildCommDCB(native, &dcb); + native = (const WCHAR *)Tcl_WinUtfToTChar(value, -1, &ds); + result = BuildCommDCBW(native, &dcb); Tcl_DStringFree(&ds); if (result == FALSE) { diff --git a/win/tclWinSock.c b/win/tclWinSock.c index e2479e81..cbc4f64 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -90,7 +90,7 @@ */ static int initialized = 0; -static const TCHAR classname[] = TEXT("TclSocket"); +static const WCHAR classname[] = L"TclSocket"; TCL_DECLARE_MUTEX(socketMutex) /* @@ -232,7 +232,7 @@ typedef struct { } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; -static WNDCLASS windowClass; +static WNDCLASSW windowClass; /* * Static routines for this file: @@ -343,16 +343,16 @@ InitializeHostName( int *lengthPtr, Tcl_Encoding *encodingPtr) { - TCHAR tbuf[MAX_COMPUTERNAME_LENGTH + 1]; + WCHAR wbuf[MAX_COMPUTERNAME_LENGTH + 1]; DWORD length = MAX_COMPUTERNAME_LENGTH + 1; Tcl_DString ds; - if (GetComputerName(tbuf, &length) != 0) { + if (GetComputerNameW(wbuf, &length) != 0) { /* * Convert string from native to UTF then change to lowercase. */ - Tcl_UtfToLower(Tcl_WinTCharToUtf(tbuf, -1, &ds)); + Tcl_UtfToLower(Tcl_WinTCharToUtf((TCHAR *)wbuf, -1, &ds)); } else { Tcl_DStringInit(&ds); @@ -2341,7 +2341,7 @@ InitSockets(void) windowClass.hIcon = NULL; windowClass.hCursor = NULL; - if (!RegisterClass(&windowClass)) { + if (!RegisterClassW(&windowClass)) { TclWinConvertError(GetLastError()); goto initFailure; } @@ -2466,7 +2466,7 @@ SocketExitHandler( */ TclpFinalizeSockets(); - UnregisterClass(classname, TclWinGetTclInstance()); + UnregisterClassW(classname, TclWinGetTclInstance()); initialized = 0; Tcl_MutexUnlock(&socketMutex); } @@ -2992,7 +2992,7 @@ SocketThread( * Create a dummy window receiving socket events. */ - tsdPtr->hwnd = CreateWindow(classname, classname, WS_TILED, 0, 0, 0, 0, + tsdPtr->hwnd = CreateWindowW(classname, classname, WS_TILED, 0, 0, 0, 0, NULL, NULL, windowClass.hInstance, arg); /* -- cgit v0.12 From 63660abb4f8bdea4d69bb947b127815223c39a27 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 18 Sep 2019 22:43:08 +0000 Subject: TEBC: avoid error "unitialized variable" if called in debug mode (or with analysis tools) - objv = NULL, similar to objc = 0 (e. g. calling parser.test, in doYield by INTERP_DEBUG_FRAME) --- generic/tclExecute.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index c5f5c0c..f86cb50 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -2178,7 +2178,7 @@ TEBCresume( */ Tcl_Obj *objPtr, *valuePtr, *value2Ptr, *part1Ptr, *part2Ptr, *tmpPtr; - Tcl_Obj **objv; + Tcl_Obj **objv = NULL; int objc = 0; int opnd, length, pcAdjustment; Var *varPtr, *arrayPtr; -- cgit v0.12 From ddd29dbbd30d295df6a6f87ded3fd8b618d957e2 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 18 Sep 2019 22:58:32 +0000 Subject: all.tcl: replacement for exit, if calling direct only (avoid rewrite exit if it is inlined or interactive shell) --- tests/all.tcl | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/tests/all.tcl b/tests/all.tcl index 287de1f..52c8763 100644 --- a/tests/all.tcl +++ b/tests/all.tcl @@ -25,4 +25,9 @@ if {[singleProcess]} { set ErrorOnFailures [info exists env(ERROR_ON_FAILURES)] unset -nocomplain env(ERROR_ON_FAILURES) if {[runAllTests] && $ErrorOnFailures} {exit 1} -proc exit args {} +# if calling direct only (avoid rewrite exit if inlined or interactive): +if { [info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]] + && !([info exists ::tcl_interactive] && $::tcl_interactive) +} { + proc exit args {} +} \ No newline at end of file -- cgit v0.12 From 3147adf34639c8a4c2aa49422c70fafb3b59c722 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 19 Sep 2019 15:09:38 +0000 Subject: Some more *A() -> *W() Win32 API changes, making Unicode calls Explicit. --- unix/tclUnixNotfy.c | 6 +++--- win/tclWinConsole.c | 10 +++------- win/tclWinFile.c | 22 ++++++---------------- win/tclWinInit.c | 2 +- win/tclWinNotify.c | 14 +++++++------- win/tclWinPipe.c | 6 +++--- win/tclWinSerial.c | 8 ++++---- win/tclWinSock.c | 46 +++++++++++++++++++++++----------------------- win/tclWinTest.c | 4 ++-- win/tclWinThrd.c | 2 +- win/tclWinTime.c | 4 ++-- 11 files changed, 55 insertions(+), 69 deletions(-) diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c index a8dbebe..aeadf49 100644 --- a/unix/tclUnixNotfy.c +++ b/unix/tclUnixNotfy.c @@ -231,7 +231,7 @@ typedef struct { void *hbrBackground; void *lpszMenuName; const void *lpszClassName; -} WNDCLASS; +} WNDCLASSW; extern void __stdcall CloseHandle(void *); extern void *__stdcall CreateEventW(void *, unsigned char, unsigned char, @@ -248,7 +248,7 @@ extern unsigned char __stdcall PeekMessageW(MSG *, void *, int, int, int); extern unsigned char __stdcall PostMessageW(void *, unsigned int, void *, void *); extern void __stdcall PostQuitMessage(int); -extern void *__stdcall RegisterClassW(const WNDCLASS *); +extern void *__stdcall RegisterClassW(const WNDCLASSW *); extern unsigned char __stdcall ResetEvent(void *); extern unsigned char __stdcall TranslateMessage(const MSG *); @@ -337,7 +337,7 @@ Tcl_InitNotifier(void) */ if (tsdPtr->waitCVinitialized == 0) { #ifdef __CYGWIN__ - WNDCLASS class; + WNDCLASSW class; class.style = 0; class.cbClsExtra = 0; diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index 6800115..449bea9 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -1037,7 +1037,7 @@ WaitForRead( return 1; } - if (PeekConsoleInput(handle, &input, 1, &count) == FALSE) { + if (PeekConsoleInputW(handle, &input, 1, &count) == FALSE) { /* * Check to see if the peek failed because of EOF. */ @@ -1337,7 +1337,7 @@ TclWinOpenConsoleChannel( modes |= ENABLE_LINE_INPUT; SetConsoleMode(infoPtr->handle, modes); - infoPtr->reader.readyEvent = CreateEvent(NULL, TRUE, TRUE, NULL); + infoPtr->reader.readyEvent = CreateEventW(NULL, TRUE, TRUE, NULL); infoPtr->reader.thread = CreateThread(NULL, 256, ConsoleReaderThread, TclPipeThreadCreateTI(&infoPtr->reader.TI, infoPtr, infoPtr->reader.readyEvent), 0, NULL); @@ -1346,7 +1346,7 @@ TclWinOpenConsoleChannel( if (permissions & TCL_WRITABLE) { - infoPtr->writer.readyEvent = CreateEvent(NULL, TRUE, TRUE, NULL); + infoPtr->writer.readyEvent = CreateEventW(NULL, TRUE, TRUE, NULL); infoPtr->writer.thread = CreateThread(NULL, 256, ConsoleWriterThread, TclPipeThreadCreateTI(&infoPtr->writer.TI, infoPtr, infoPtr->writer.readyEvent), 0, NULL); @@ -1360,11 +1360,7 @@ TclWinOpenConsoleChannel( Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto"); Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}"); -#ifdef UNICODE Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", "unicode"); -#else - Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", encoding); -#endif return infoPtr->channel; } diff --git a/win/tclWinFile.c b/win/tclWinFile.c index bda0592..20cd6d4 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -572,7 +572,7 @@ WinReadLinkDirectory( */ offset = 0; -#ifdef UNICODE +#if 1 if (reparseBuffer->MountPointReparseBuffer.PathBuffer[0] == L'\\') { /* * Check whether this is a mounted volume. @@ -880,17 +880,7 @@ TclpFindExecutable( Tcl_SetPanicProc(tclWinDebugPanic); } -#ifdef UNICODE GetModuleFileNameW(NULL, wName, MAX_PATH); -#else - GetModuleFileNameA(NULL, name, sizeof(name)); - - /* - * Convert to WCHAR to get out of ANSI codepage - */ - - MultiByteToWideChar(CP_ACP, 0, name, -1, wName, MAX_PATH); -#endif WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL); TclWinNoBackslash(name); TclSetObjNameOfExecutable(Tcl_NewStringObj(name, -1), NULL); @@ -1701,7 +1691,7 @@ NativeAccess( * what permissions the OS has set for a file. */ -#ifdef UNICODE +#if 1 { SECURITY_DESCRIPTOR *sdPtr = NULL; unsigned long size; @@ -1721,7 +1711,7 @@ NativeAccess( */ size = 0; - GetFileSecurity(nativePath, + GetFileSecurityW(nativePath, OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION | LABEL_SECURITY_INFORMATION, 0, 0, &size); @@ -1752,10 +1742,10 @@ NativeAccess( } /* - * Call GetFileSecurity() for real. + * Call GetFileSecurityW() for real. */ - if (!GetFileSecurity(nativePath, + if (!GetFileSecurityW(nativePath, OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION | LABEL_SECURITY_INFORMATION, sdPtr, size, &size)) { @@ -3300,7 +3290,7 @@ TclWinFileOwned( native = Tcl_FSGetNativePath(pathPtr); - if (GetNamedSecurityInfo((LPTSTR) native, SE_FILE_OBJECT, + if (GetNamedSecurityInfoW((LPWSTR) native, SE_FILE_OBJECT, OWNER_SECURITY_INFORMATION, &ownerSid, NULL, NULL, NULL, &secd) != ERROR_SUCCESS) { /* diff --git a/win/tclWinInit.c b/win/tclWinInit.c index afa6bf4..cb13b20 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -310,7 +310,7 @@ AppendEnvironment( Tcl_SplitPath(buf, &pathc, &pathv); /* - * The lstrcmpi() will work even if pathv[pathc-1] is random UTF-8 + * The lstrcmpiA() will work even if pathv[pathc-1] is random UTF-8 * chars because I know shortlib is ascii. */ diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c index bb0eb18..2542476 100644 --- a/win/tclWinNotify.c +++ b/win/tclWinNotify.c @@ -117,7 +117,7 @@ Tcl_InitNotifier(void) tsdPtr->hwnd = NULL; tsdPtr->thread = GetCurrentThreadId(); - tsdPtr->event = CreateEvent(NULL, TRUE /* manual */, + tsdPtr->event = CreateEventW(NULL, TRUE /* manual */, FALSE /* !signaled */, NULL); return tsdPtr; @@ -237,7 +237,7 @@ Tcl_AlertNotifier( EnterCriticalSection(&tsdPtr->crit); if (!tsdPtr->pending) { - PostMessage(tsdPtr->hwnd, WM_WAKEUP, 0, 0); + PostMessageW(tsdPtr->hwnd, WM_WAKEUP, 0, 0); } tsdPtr->pending = 1; LeaveCriticalSection(&tsdPtr->crit); @@ -398,7 +398,7 @@ NotifierProc( tsdPtr->pending = 0; LeaveCriticalSection(&tsdPtr->crit); } else if (message != WM_TIMER) { - return DefWindowProc(hwnd, message, wParam, lParam); + return DefWindowProcW(hwnd, message, wParam, lParam); } /* @@ -470,7 +470,7 @@ Tcl_WaitForEvent( * events currently sitting in the queue. */ - if (!PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) { + if (!PeekMessageW(&msg, NULL, 0, 0, PM_NOREMOVE)) { /* * Wait for something to happen (a signal from another thread, a * message, or timeout) or loop servicing asynchronous procedure @@ -492,12 +492,12 @@ Tcl_WaitForEvent( * Check to see if there are any messages to process. */ - if (PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) { + if (PeekMessageW(&msg, NULL, 0, 0, PM_NOREMOVE)) { /* * Retrieve and dispatch the first message. */ - result = GetMessage(&msg, NULL, 0, 0); + result = GetMessageW(&msg, NULL, 0, 0); if (result == 0) { /* * We received a request to exit this thread (WM_QUIT), so @@ -515,7 +515,7 @@ Tcl_WaitForEvent( status = -1; } else { TranslateMessage(&msg); - DispatchMessage(&msg); + DispatchMessageW(&msg); status = 1; } } else { diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 4399b71..191545b 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -1801,7 +1801,7 @@ TclpCreateCommandChannel( * Start the background reader thread. */ - infoPtr->readable = CreateEvent(NULL, TRUE, TRUE, NULL); + infoPtr->readable = CreateEventW(NULL, TRUE, TRUE, NULL); infoPtr->readThread = CreateThread(NULL, 256, PipeReaderThread, TclPipeThreadCreateTI(&infoPtr->readTI, infoPtr, infoPtr->readable), 0, NULL); @@ -1816,7 +1816,7 @@ TclpCreateCommandChannel( * Start the background writer thread. */ - infoPtr->writable = CreateEvent(NULL, TRUE, TRUE, NULL); + infoPtr->writable = CreateEventW(NULL, TRUE, TRUE, NULL); infoPtr->writeThread = CreateThread(NULL, 256, PipeWriterThread, TclPipeThreadCreateTI(&infoPtr->writeTI, infoPtr, infoPtr->writable), 0, NULL); @@ -3300,7 +3300,7 @@ TclPipeThreadCreateTI( #else pipeTI = ckalloc(sizeof(TclPipeThreadInfo)); #endif /* !_PTI_USE_CKALLOC */ - pipeTI->evControl = CreateEvent(NULL, FALSE, FALSE, NULL); + pipeTI->evControl = CreateEventW(NULL, FALSE, FALSE, NULL); pipeTI->state = PTI_STATE_IDLE; pipeTI->clientData = clientData; pipeTI->evWakeUp = wakeEvent; diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index 8cf8b55..4f7c0be 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -1283,7 +1283,7 @@ SerialWriterThread( buf = infoPtr->writeBuf; toWrite = infoPtr->toWrite; - myWrite.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL); + myWrite.hEvent = CreateEventW(NULL, TRUE, FALSE, NULL); /* * Loop until all of the bytes are written or an error occurs. @@ -1460,15 +1460,15 @@ TclWinOpenSerialChannel( InitializeCriticalSection(&infoPtr->csWrite); if (permissions & TCL_READABLE) { - infoPtr->osRead.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL); + infoPtr->osRead.hEvent = CreateEventW(NULL, TRUE, FALSE, NULL); } if (permissions & TCL_WRITABLE) { /* * Initially the channel is writable and the writeThread is idle. */ - infoPtr->osWrite.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL); - infoPtr->evWritable = CreateEvent(NULL, TRUE, TRUE, NULL); + infoPtr->osWrite.hEvent = CreateEventW(NULL, TRUE, FALSE, NULL); + infoPtr->evWritable = CreateEventW(NULL, TRUE, TRUE, NULL); infoPtr->writeThread = CreateThread(NULL, 256, SerialWriterThread, TclPipeThreadCreateTI(&infoPtr->writeTI, infoPtr, infoPtr->evWritable), 0, NULL); diff --git a/win/tclWinSock.c b/win/tclWinSock.c index cbc4f64..ed633ef 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -481,7 +481,7 @@ TclpFinalizeSockets(void) if (tsdPtr->socketThread != NULL) { if (tsdPtr->hwnd != NULL) { - PostMessage(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0); + PostMessageW(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0); /* * Wait for the thread to exit. This ensures that we are @@ -777,7 +777,7 @@ TcpInputProc( */ while (1) { - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, + SendMessageW(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT, (LPARAM) statePtr); /* single fd operation: this proc is only called for a connected socket. */ bytesRead = recv(statePtr->sockets->fd, buf, bufSize, 0); @@ -840,7 +840,7 @@ TcpInputProc( } } - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)statePtr); + SendMessageW(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)statePtr); return bytesRead; } @@ -898,7 +898,7 @@ TcpOutputProc( } while (1) { - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, + SendMessageW(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT, (LPARAM) statePtr); /* single fd operation: this proc is only called for a connected socket. */ @@ -950,7 +950,7 @@ TcpOutputProc( } } - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)statePtr); + SendMessageW(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)statePtr); return written; } @@ -1761,7 +1761,7 @@ TcpConnect( SetEvent(tsdPtr->socketListLock); /* activate accept notification */ - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, + SendMessageW(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, (LPARAM) statePtr); } @@ -1841,7 +1841,7 @@ out: * automatically places the socket into non-blocking mode. */ - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, + SendMessageW(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, (LPARAM) statePtr); } else { /* @@ -2017,7 +2017,7 @@ Tcl_MakeTcpClientChannel( */ statePtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE; - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)statePtr); + SendMessageW(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)statePtr); sprintf(channelName, SOCK_TEMPLATE, statePtr); statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, @@ -2195,7 +2195,7 @@ error: */ ioctlsocket(sock, (long) FIONBIO, &flag); - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, + SendMessageW(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, (LPARAM) statePtr); if (Tcl_SetChannelOption(interp, statePtr->channel, "-eofchar", "") == TCL_ERROR) { @@ -2265,7 +2265,7 @@ TcpAccept( */ newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE); - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, + SendMessageW(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, (LPARAM) newInfoPtr); sprintf(channelName, SOCK_TEMPLATE, newInfoPtr); @@ -2366,11 +2366,11 @@ InitSockets(void) tsdPtr->socketList = NULL; tsdPtr->hwnd = NULL; tsdPtr->threadId = Tcl_GetCurrentThread(); - tsdPtr->readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL); + tsdPtr->readyEvent = CreateEventW(NULL, FALSE, FALSE, NULL); if (tsdPtr->readyEvent == NULL) { goto initFailure; } - tsdPtr->socketListLock = CreateEvent(NULL, FALSE, TRUE, NULL); + tsdPtr->socketListLock = CreateEventW(NULL, FALSE, TRUE, NULL); if (tsdPtr->socketListLock == NULL) { goto initFailure; } @@ -2771,7 +2771,7 @@ SocketEventProc( * async select handler and keep waiting. */ - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, + SendMessageW(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT, (LPARAM) statePtr); FD_ZERO(&readFds); @@ -2783,7 +2783,7 @@ SocketEventProc( mask |= TCL_READABLE; } else { statePtr->readyEvents &= ~(FD_READ); - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, + SendMessageW(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, (LPARAM) statePtr); } } @@ -2925,9 +2925,9 @@ WaitForSocketEvent( * Reset WSAAsyncSelect so we have a fresh set of events pending. */ - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT, + SendMessageW(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT, (LPARAM) statePtr); - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, + SendMessageW(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, (LPARAM) statePtr); while (1) { @@ -3012,11 +3012,11 @@ SocketThread( /* * Process all messages on the socket window until WM_QUIT. This threads * exits only when instructed to do so by the call to - * PostMessage(SOCKET_TERMINATE) in TclpFinalizeSockets(). + * PostMessageW(SOCKET_TERMINATE) in TclpFinalizeSockets(). */ - while (GetMessage(&msg, NULL, 0, 0) > 0) { - DispatchMessage(&msg); + while (GetMessageW(&msg, NULL, 0, 0) > 0) { + DispatchMessageW(&msg); } /* @@ -3061,14 +3061,14 @@ SocketProc( TcpFdList *fds = NULL; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) #ifdef _WIN64 - GetWindowLongPtr(hwnd, GWLP_USERDATA); + GetWindowLongPtrW(hwnd, GWLP_USERDATA); #else GetWindowLong(hwnd, GWL_USERDATA); #endif switch (message) { default: - return DefWindowProc(hwnd, message, wParam, lParam); + return DefWindowProcW(hwnd, message, wParam, lParam); break; case WM_CREATE: @@ -3078,7 +3078,7 @@ SocketProc( */ #ifdef _WIN64 - SetWindowLongPtr(hwnd, GWLP_USERDATA, + SetWindowLongPtrW(hwnd, GWLP_USERDATA, (LONG_PTR) ((LPCREATESTRUCT)lParam)->lpCreateParams); #else SetWindowLong(hwnd, GWL_USERDATA, @@ -3361,7 +3361,7 @@ TcpThreadActionProc( * thread. */ - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, + SendMessageW(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) notifyCmd, (LPARAM) statePtr); } diff --git a/win/tclWinTest.c b/win/tclWinTest.c index 5f5ede9..dd4d5ec 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -139,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. @@ -149,7 +149,7 @@ TesteventloopCmd( break; } TranslateMessage(&msg); - DispatchMessage(&msg); + DispatchMessageW(&msg); } (void) Tcl_SetServiceMode(oldMode); framePtr = oldFramePtr; diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index 0f83526..5316075 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -688,7 +688,7 @@ Tcl_ConditionWait( */ if (tsdPtr->flags == WIN_THREAD_UNINIT) { - tsdPtr->condEvent = CreateEvent(NULL, TRUE /* manual reset */, + tsdPtr->condEvent = CreateEventW(NULL, TRUE /* manual reset */, FALSE /* non signaled */, NULL); tsdPtr->nextPtr = NULL; tsdPtr->prevPtr = NULL; diff --git a/win/tclWinTime.c b/win/tclWinTime.c index 7de0941..33d87a7 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -544,8 +544,8 @@ NativeGetMicroseconds(void) DWORD id; InitializeCriticalSection(&timeInfo.cs); - timeInfo.readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL); - timeInfo.exitEvent = CreateEvent(NULL, FALSE, FALSE, NULL); + timeInfo.readyEvent = CreateEventW(NULL, FALSE, FALSE, NULL); + timeInfo.exitEvent = CreateEventW(NULL, FALSE, FALSE, NULL); timeInfo.calibrationThread = CreateThread(NULL, 256, CalibrationThread, (LPVOID) NULL, 0, &id); SetThreadPriority(timeInfo.calibrationThread, -- cgit v0.12 From 1ed3c75ba4badbf5e1aece5cbc3d976d1f699fa2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 20 Sep 2019 14:59:18 +0000 Subject: Modify registry/dde such that they no longer need to be compiled with -DUNICODE. Also no longer use Tcl_WinTCharToUtf/Tcl_WinUtfToTchar but the unicode conversions functions to do WCHAR <=> UTF-8 conversions. When compiled with Tcl >= 8.7, use the TIP #548 wchar_t functions in stead for registry/dde. --- win/Makefile.in | 4 +- win/makefile.vc | 56 +++++------ win/tclWinDde.c | 293 ++++++++++++++++++++++++++++++++------------------------ win/tclWinReg.c | 155 ++++++++++++++++++------------ 4 files changed, 289 insertions(+), 219 deletions(-) diff --git a/win/Makefile.in b/win/Makefile.in index 8561bc2..4a58014 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -502,11 +502,11 @@ tclWinPipe.${OBJEXT}: tclWinPipe.c $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) tclWinReg.${OBJEXT}: tclWinReg.c - $(CC) -c $(CC_SWITCHES) -DUNICODE -D_UNICODE \ + $(CC) -c $(CC_SWITCHES) \ $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) tclWinDde.${OBJEXT}: tclWinDde.c - $(CC) -c $(CC_SWITCHES) -DUNICODE -D_UNICODE \ + $(CC) -c $(CC_SWITCHES) \ $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) testMain.${OBJEXT}: tclAppInit.c diff --git a/win/makefile.vc b/win/makefile.vc index e2ec8ab..8fe5281 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -437,7 +437,7 @@ cdebug = -Zi -WX $(DEBUGFLAGS) !endif ### Declarations common to all compiler options -cwarn = $(WARNINGS) -D _CRT_SECURE_NO_DEPRECATE -D _CRT_NONSTDC_NO_DEPRECATE +cwarn = $(WARNINGS) /D_CRT_SECURE_NO_DEPRECATE /D_CRT_NONSTDC_NO_DEPRECATE cflags = -nologo -c $(COMPILERFLAGS) $(cwarn) -Fp$(TMP_DIR)^\ !if $(MSVCRT) @@ -455,9 +455,9 @@ crt = -MT !endif TCL_INCLUDES = -I"$(WIN_DIR)" -I"$(GENERICDIR)" -I"$(TOMMATHDIR)" -TCL_DEFINES = -DTCL_PIPE_DLL=\"$(TCLPIPEDLLNAME)\" -DTCL_TOMMATH -DMP_PREC=4 -Dinline=__inline +TCL_DEFINES = /DTCL_PIPE_DLL=\"$(TCLPIPEDLLNAME)\" /DTCL_TOMMATH /DMP_PREC=4 /Dinline=__inline BASE_CFLAGS = $(cflags) $(cdebug) $(crt) $(TCL_INCLUDES) $(TCL_DEFINES) -CON_CFLAGS = $(cflags) $(cdebug) $(crt) -DCONSOLE +CON_CFLAGS = $(cflags) $(cdebug) $(crt) /DCONSOLE TCL_CFLAGS = $(BASE_CFLAGS) $(OPTDEFINES) STUB_CFLAGS = $(cflags) $(cdebug) $(OPTDEFINES) @@ -850,8 +850,8 @@ gendate: #--------------------------------------------------------------------- $(TMP_DIR)\testMain.obj: $(WIN_DIR)\tclAppInit.c - $(cc32) $(TCL_CFLAGS) -DTCL_TEST \ - -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \ + $(cc32) $(TCL_CFLAGS) /DTCL_TEST \ + /DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \ -Fo$@ $? $(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c @@ -864,40 +864,40 @@ $(TMP_DIR)\tclWinTest.obj: $(WIN_DIR)\tclWinTest.c $(cc32) $(TCL_CFLAGS) -Fo$@ $? $(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c - $(cc32) -DBUILD_tcl $(TCL_CFLAGS) \ - -DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \ - -DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \ - -DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \ - -DCFG_INSTALL_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \ - -DCFG_INSTALL_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \ - -DCFG_RUNTIME_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \ - -DCFG_RUNTIME_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \ - -DCFG_RUNTIME_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \ - -DCFG_RUNTIME_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \ - -DCFG_RUNTIME_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \ + $(cc32) /DBUILD_tcl $(TCL_CFLAGS) \ + /DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \ + /DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \ + /DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \ + /DCFG_INSTALL_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \ + /DCFG_INSTALL_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \ + /DCFG_RUNTIME_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \ + /DCFG_RUNTIME_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \ + /DCFG_RUNTIME_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \ + /DCFG_RUNTIME_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \ + /DCFG_RUNTIME_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \ -Fo$@ $? $(TMP_DIR)\tclAppInit.obj: $(WIN_DIR)\tclAppInit.c $(cc32) $(TCL_CFLAGS) \ - -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \ + /DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \ -Fo$@ $? ### The following objects should be built using the stub interfaces -### *ALL* extensions need to built with -DTCL_THREADS=1 +### *ALL* extensions need to built with /DTCL_THREADS=1 $(TMP_DIR)\tclWinReg.obj: $(WIN_DIR)\tclWinReg.c !if $(STATIC_BUILD) - $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -DUNICODE -D_UNICODE -Fo$@ $? + $(cc32) $(TCL_CFLAGS) /DTCL_THREADS=1 /DSTATIC_BUILD -Fo$@ $? !else - $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -DUNICODE -D_UNICODE -Fo$@ $? + $(cc32) $(TCL_CFLAGS) /DTCL_THREADS=1 /DUSE_TCL_STUBS -Fo$@ $? !endif $(TMP_DIR)\tclWinDde.obj: $(WIN_DIR)\tclWinDde.c !if $(STATIC_BUILD) - $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -DUNICODE -D_UNICODE -Fo$@ $? + $(cc32) $(TCL_CFLAGS) /DTCL_THREADS=1 /DSTATIC_BUILD -Fo$@ $? !else - $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -DUNICODE -D_UNICODE -Fo$@ $? + $(cc32) $(TCL_CFLAGS) /DTCL_THREADS=1 /DUSE_TCL_STUBS -Fo$@ $? !endif @@ -906,7 +906,7 @@ $(TMP_DIR)\tclWinDde.obj: $(WIN_DIR)\tclWinDde.c ### specific C run-time. $(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c - $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $? + $(cc32) $(STUB_CFLAGS) -Zl /DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $? $(TMP_DIR)\tclsh.exe.manifest: $(WIN_DIR)\tclsh.exe.manifest.in @nmakehlp -s << $** >$@ @@ -927,7 +927,7 @@ depend: @echo Build tclsh first! !else $(TCLSH) $(TOOLSDIR:\=/)/mkdepend.tcl -vc32 -out:"$(OUT_DIR)\depend.mk" \ - -passthru:"-DBUILD_tcl $(TCL_INCLUDES)" $(GENERICDIR),$$(GENERICDIR) \ + -passthru:"/DBUILD_tcl $(TCL_INCLUDES)" $(GENERICDIR),$$(GENERICDIR) \ $(COMPATDIR),$$(COMPATDIR) $(TOMMATHDIR),$$(TOMMATHDIR) $(WIN_DIR),$$(WIN_DIR) @<< $(TCLOBJS) << @@ -953,22 +953,22 @@ $(TCLOBJS) #--------------------------------------------------------------------- {$(WIN_DIR)}.c{$(TMP_DIR)}.obj:: - $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<< + $(cc32) $(TCL_CFLAGS) /DBUILD_tcl -Fo$(TMP_DIR)\ @<< $< << {$(TOMMATHDIR)}.c{$(TMP_DIR)}.obj:: - $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<< + $(cc32) $(TCL_CFLAGS) /DBUILD_tcl -Fo$(TMP_DIR)\ @<< $< << {$(GENERICDIR)}.c{$(TMP_DIR)}.obj:: - $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<< + $(cc32) $(TCL_CFLAGS) /DBUILD_tcl -Fo$(TMP_DIR)\ @<< $< << {$(COMPATDIR)}.c{$(TMP_DIR)}.obj:: - $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<< + $(cc32) $(TCL_CFLAGS) /DBUILD_tcl -Fo$(TMP_DIR)\ @<< $< << diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 27ddfc8..6fa9cc2 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -34,7 +34,7 @@ typedef struct RegisteredInterp { struct RegisteredInterp *nextPtr; /* The next interp this application knows * about. */ - TCHAR *name; /* Interpreter's name (malloc-ed). */ + WCHAR *name; /* Interpreter's name (malloc-ed). */ Tcl_Obj *handlerPtr; /* The server handler command */ Tcl_Interp *interp; /* The interpreter attached to this name. */ } RegisteredInterp; @@ -81,8 +81,8 @@ static int ddeIsServer = 0; #define TCL_DDE_VERSION "1.4.1" #define TCL_DDE_PACKAGE_NAME "dde" -#define TCL_DDE_SERVICE_NAME TEXT("TclEval") -#define TCL_DDE_EXECUTE_RESULT TEXT("$TCLEVAL$EXECUTE$RESULT") +#define TCL_DDE_SERVICE_NAME L"TclEval" +#define TCL_DDE_EXECUTE_RESULT L"$TCLEVAL$EXECUTE$RESULT" #define DDE_FLAG_ASYNC 1 #define DDE_FLAG_BINARY 2 @@ -99,24 +99,34 @@ static LRESULT CALLBACK DdeClientWindowProc(HWND hwnd, UINT uMsg, static int DdeCreateClient(DdeEnumServices *es); static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget, LPARAM lParam); -static void DdeExitProc(ClientData clientData); +static void DdeExitProc(void *clientData); static int DdeGetServicesList(Tcl_Interp *interp, - const TCHAR *serviceName, const TCHAR *topicName); + const WCHAR *serviceName, const WCHAR *topicName); static HDDEDATA CALLBACK DdeServerProc(UINT uType, UINT uFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem, HDDEDATA hData, DWORD dwData1, DWORD dwData2); static LRESULT DdeServicesOnAck(HWND hwnd, WPARAM wParam, LPARAM lParam); -static void DeleteProc(ClientData clientData); +static void DeleteProc(void *clientData); static Tcl_Obj * ExecuteRemoteObject(RegisteredInterp *riPtr, Tcl_Obj *ddeObjectPtr); static int MakeDdeConnection(Tcl_Interp *interp, - const TCHAR *name, HCONV *ddeConvPtr); + const WCHAR *name, HCONV *ddeConvPtr); static void SetDdeError(Tcl_Interp *interp); -static int DdeObjCmd(ClientData clientData, +static int DdeObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +#if (TCL_MAJOR_VERSION < 9) && (TCL_MINOR_VERSION < 7) +# if TCL_UTF_MAX > 3 +# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf(a,(b)*sizeof(WCHAR),c) +# define Tcl_UtfToWCharDString(a,b,c) Tcl_WinUtfToTChar(a,b,c) +# else +# define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString +# define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString +# endif +#endif + static unsigned char * getByteArrayFromObj( Tcl_Obj *objPtr, @@ -136,8 +146,14 @@ getByteArrayFromObj( return result; } +#ifdef __cplusplus +extern "C" { +#endif DLLEXPORT int Dde_Init(Tcl_Interp *interp); DLLEXPORT int Dde_SafeInit(Tcl_Interp *interp); +#ifdef __cplusplus +} +#endif /* *---------------------------------------------------------------------- @@ -159,13 +175,13 @@ int Dde_Init( Tcl_Interp *interp) { - if (!Tcl_InitStubs(interp, "8.1", 0)) { + if (!Tcl_InitStubs(interp, "8.5-", 0)) { return TCL_ERROR; } Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL); Tcl_CreateExitHandler(DdeExitProc, NULL); - return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION); + return Tcl_PkgProvideEx(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION, NULL); } /* @@ -235,7 +251,7 @@ Initialize(void) if (ddeInstance == 0) { Tcl_MutexLock(&ddeMutex); if (ddeInstance == 0) { - if (DdeInitialize(&ddeInstance, (PFNCALLBACK) DdeServerProc, + if (DdeInitializeW(&ddeInstance, (PFNCALLBACK) DdeServerProc, CBF_SKIP_REGISTRATIONS | CBF_SKIP_UNREGISTRATIONS | CBF_FAIL_POKES, 0) != DMLERR_NO_ERROR) { ddeInstance = 0; @@ -248,7 +264,7 @@ Initialize(void) if ((ddeServiceGlobal == 0) && (nameFound != 0)) { ddeIsServer = 1; Tcl_CreateExitHandler(DdeExitProc, NULL); - ddeServiceGlobal = DdeCreateStringHandle(ddeInstance, + ddeServiceGlobal = DdeCreateStringHandleW(ddeInstance, TCL_DDE_SERVICE_NAME, CP_WINUNICODE); DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER); } else { @@ -283,10 +299,10 @@ Initialize(void) *---------------------------------------------------------------------- */ -static const TCHAR * +static const WCHAR * DdeSetServerName( Tcl_Interp *interp, - const TCHAR *name, /* The name that will be used to refer to the + const WCHAR *name, /* The name that will be used to refer to the * interpreter in later "send" commands. Must * be globally unique. */ int flags, /* DDE_FLAG_FORCE or 0 */ @@ -296,7 +312,7 @@ DdeSetServerName( int suffix, offset; RegisteredInterp *riPtr, *prevPtr; Tcl_DString dString; - const TCHAR *actualName; + const WCHAR *actualName; Tcl_Obj *srvListPtr = NULL, **srvPtrPtr = NULL; int n, srvCount = 0, lastSuffix, r = TCL_OK; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -334,7 +350,7 @@ DdeSetServerName( * current interp, but it doesn't have a name. */ - return TEXT(""); + return L""; } /* @@ -355,8 +371,8 @@ DdeSetServerName( &srvPtrPtr); } if (r != TCL_OK) { - Tcl_WinUtfToTChar(Tcl_GetStringResult(interp), -1, &dString); - OutputDebugString((TCHAR *) Tcl_DStringValue(&dString)); + Tcl_DStringInit(&dString); + OutputDebugStringW(Tcl_UtfToWCharDString(Tcl_GetString(Tcl_GetObjResult(interp)), -1, &dString)); Tcl_DStringFree(&dString); return NULL; } @@ -374,14 +390,14 @@ DdeSetServerName( lastSuffix = suffix; if (suffix > 1) { if (suffix == 2) { - Tcl_DStringAppend(&dString, (char *)name, _tcslen(name) * sizeof(TCHAR)); - Tcl_DStringAppend(&dString, (char *)TEXT(" #"), 2 * sizeof(TCHAR)); + Tcl_DStringAppend(&dString, (char *)name, wcslen(name) * sizeof(WCHAR)); + Tcl_DStringAppend(&dString, (char *)L" #", 2 * sizeof(WCHAR)); offset = Tcl_DStringLength(&dString); - Tcl_DStringSetLength(&dString, offset + sizeof(TCHAR) * TCL_INTEGER_SPACE); - actualName = (TCHAR *) Tcl_DStringValue(&dString); + Tcl_DStringSetLength(&dString, offset + sizeof(WCHAR) * TCL_INTEGER_SPACE); + actualName = (WCHAR *) Tcl_DStringValue(&dString); } - _sntprintf((TCHAR *) (Tcl_DStringValue(&dString) + offset), - TCL_INTEGER_SPACE, TEXT("%d"), suffix); + _snwprintf((WCHAR *) (Tcl_DStringValue(&dString) + offset), + TCL_INTEGER_SPACE, L"%d", suffix); } /* @@ -393,8 +409,9 @@ DdeSetServerName( Tcl_DString ds; Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr); - Tcl_WinUtfToTChar(Tcl_GetString(namePtr), -1, &ds); - if (_tcscmp(actualName, (TCHAR *)Tcl_DStringValue(&ds)) == 0) { + Tcl_DStringInit(&ds); + Tcl_UtfToWCharDString(Tcl_GetString(namePtr), -1, &ds); + if (wcscmp(actualName, (WCHAR *)Tcl_DStringValue(&ds)) == 0) { suffix++; Tcl_DStringFree(&ds); break; @@ -410,14 +427,14 @@ DdeSetServerName( riPtr = (RegisteredInterp *) Tcl_Alloc(sizeof(RegisteredInterp)); riPtr->interp = interp; - riPtr->name = (TCHAR *) Tcl_Alloc((_tcslen(actualName) + 1) * sizeof(TCHAR)); + riPtr->name = (WCHAR *) Tcl_Alloc((wcslen(actualName) + 1) * sizeof(WCHAR)); riPtr->nextPtr = tsdPtr->interpListPtr; riPtr->handlerPtr = handlerPtr; if (riPtr->handlerPtr != NULL) { Tcl_IncrRefCount(riPtr->handlerPtr); } tsdPtr->interpListPtr = riPtr; - _tcscpy(riPtr->name, actualName); + wcscpy(riPtr->name, actualName); if (Tcl_IsSafe(interp)) { Tcl_ExposeCommand(interp, "dde", "dde"); @@ -489,8 +506,7 @@ DdeGetRegistrationPtr( static void DeleteProc( - ClientData clientData) /* The interp we are deleting passed as - * ClientData. */ + void *clientData) /* The interp we are deleting. */ { RegisteredInterp *riPtr = (RegisteredInterp *) clientData; RegisteredInterp *searchPtr, *prevPtr; @@ -627,18 +643,20 @@ DdeServerProc( HSZ ddeTopic, HSZ ddeItem, /* String handles. Transaction-type * dependent. */ HDDEDATA hData, /* DDE data. Transaction-type dependent. */ - DWORD dwData1, DWORD dwData2) + DWORD unused1, DWORD unused2) /* Transaction-dependent data. */ { Tcl_DString dString; size_t len; DWORD dlen; - TCHAR *utilString; + WCHAR *utilString; Tcl_Obj *ddeObjectPtr; HDDEDATA ddeReturn = NULL; RegisteredInterp *riPtr; Conversation *convPtr, *prevConvPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + (void)unused1; + (void)unused2; switch(uType) { case XTYP_CONNECT: @@ -647,16 +665,16 @@ DdeServerProc( * sure we have a valid topic. */ - len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE); + len = DdeQueryStringW(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE); Tcl_DStringInit(&dString); - Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); - utilString = (TCHAR *) Tcl_DStringValue(&dString); - DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, + Tcl_DStringSetLength(&dString, (len + 1) * sizeof(WCHAR) - 1); + utilString = (WCHAR *) Tcl_DStringValue(&dString); + DdeQueryStringW(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, CP_WINUNICODE); for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (_tcsicmp(utilString, riPtr->name) == 0) { + if (_wcsicmp(utilString, riPtr->name) == 0) { Tcl_DStringFree(&dString); return (HDDEDATA) TRUE; } @@ -672,15 +690,15 @@ DdeServerProc( * result to return in an XTYP_REQUEST. */ - len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE); + len = DdeQueryStringW(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE); Tcl_DStringInit(&dString); - Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); - utilString = (TCHAR *) Tcl_DStringValue(&dString); - DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, + Tcl_DStringSetLength(&dString, (len + 1) * sizeof(WCHAR) - 1); + utilString = (WCHAR *) Tcl_DStringValue(&dString); + DdeQueryStringW(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, CP_WINUNICODE); for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (_tcsicmp(riPtr->name, utilString) == 0) { + if (_wcsicmp(riPtr->name, utilString) == 0) { convPtr = (Conversation *) Tcl_Alloc(sizeof(Conversation)); convPtr->nextPtr = tsdPtr->currentConversations; convPtr->returnPackagePtr = NULL; @@ -740,21 +758,22 @@ DdeServerProc( Tcl_DString dsBuf; char *returnString; - len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE); + len = DdeQueryStringW(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE); Tcl_DStringInit(&dString); Tcl_DStringInit(&dsBuf); - Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); - utilString = (TCHAR *) Tcl_DStringValue(&dString); - DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1, + Tcl_DStringSetLength(&dString, (len + 1) * sizeof(WCHAR) - 1); + utilString = (WCHAR *) Tcl_DStringValue(&dString); + DdeQueryStringW(ddeInstance, ddeItem, utilString, (DWORD) len + 1, CP_WINUNICODE); - if (_tcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { + if (_wcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { returnString = Tcl_GetString(convPtr->returnPackagePtr); len = convPtr->returnPackagePtr->length; if (uFmt != CF_TEXT) { - Tcl_WinUtfToTChar(returnString, len, &dsBuf); + Tcl_DStringInit(&dsBuf); + Tcl_UtfToWCharDString(returnString, len, &dsBuf); returnString = Tcl_DStringValue(&dsBuf); - len = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR) - 1; + len = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR) - 1; } ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, uFmt, 0); @@ -765,7 +784,8 @@ DdeServerProc( Tcl_DString ds; Tcl_Obj *variableObjPtr; - Tcl_WinTCharToUtf(utilString, -1, &ds); + Tcl_DStringInit(&ds); + Tcl_WCharToUtfDString(utilString, wcslen(utilString), &ds); variableObjPtr = Tcl_GetVar2Ex( convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL, TCL_GLOBAL_ONLY); @@ -773,9 +793,10 @@ DdeServerProc( returnString = Tcl_GetString(variableObjPtr); len = variableObjPtr->length; if (uFmt != CF_TEXT) { - Tcl_WinUtfToTChar(returnString, len, &dsBuf); + Tcl_DStringInit(&dsBuf); + Tcl_UtfToWCharDString(returnString, len, &dsBuf); returnString = Tcl_DStringValue(&dsBuf); - len = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR) - 1; + len = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR) - 1; } ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, @@ -817,17 +838,19 @@ DdeServerProc( Tcl_DStringInit(&dString); Tcl_DStringInit(&ds2); - len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE); - Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); - utilString = (TCHAR *) Tcl_DStringValue(&dString); - DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1, + len = DdeQueryStringW(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE); + Tcl_DStringSetLength(&dString, (len + 1) * sizeof(WCHAR) - 1); + utilString = (WCHAR *) Tcl_DStringValue(&dString); + DdeQueryStringW(ddeInstance, ddeItem, utilString, (DWORD) len + 1, CP_WINUNICODE); - Tcl_WinTCharToUtf(utilString, -1, &ds); - utilString = (TCHAR *) DdeAccessData(hData, &len2); + Tcl_DStringInit(&ds); + Tcl_WCharToUtfDString(utilString, wcslen(utilString), &ds); + utilString = (WCHAR *) DdeAccessData(hData, &len2); len = len2; if (uFmt != CF_TEXT) { - Tcl_WinTCharToUtf(utilString, -1, &ds2); - utilString = (TCHAR *) Tcl_DStringValue(&ds2); + Tcl_DStringInit(&ds2); + Tcl_WCharToUtfDString(utilString, wcslen(utilString), &ds2); + utilString = (WCHAR *) Tcl_DStringValue(&ds2); } variableObjPtr = Tcl_NewStringObj((char *)utilString, -1); @@ -862,7 +885,7 @@ DdeServerProc( return (HDDEDATA) DDE_FNOTPROCESSED; } - utilString = (TCHAR *) DdeAccessData(hData, &dlen); + utilString = (WCHAR *) DdeAccessData(hData, &dlen); string = (char *) utilString; if (!dlen) { /* Empty binary array. */ @@ -877,7 +900,8 @@ DdeServerProc( /* unicode */ Tcl_DString dsBuf; - Tcl_WinTCharToUtf(utilString, dlen - sizeof(TCHAR), &dsBuf); + Tcl_DStringInit(&dsBuf); + Tcl_WCharToUtfDString(utilString, (dlen>>1) - 1, &dsBuf); ddeObjectPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf), Tcl_DStringLength(&dsBuf)); Tcl_DStringFree(&dsBuf); @@ -932,9 +956,9 @@ DdeServerProc( len = dlen; for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems; i++, riPtr = riPtr->nextPtr) { - returnPtr[i].hszSvc = DdeCreateStringHandle(ddeInstance, + returnPtr[i].hszSvc = DdeCreateStringHandleW(ddeInstance, TCL_DDE_SERVICE_NAME, CP_WINUNICODE); - returnPtr[i].hszTopic = DdeCreateStringHandle(ddeInstance, + returnPtr[i].hszTopic = DdeCreateStringHandleW(ddeInstance, riPtr->name, CP_WINUNICODE); } returnPtr[i].hszSvc = NULL; @@ -966,8 +990,9 @@ DdeServerProc( static void DdeExitProc( - ClientData clientData) /* Not used in this handler. */ + void *dummy) /* Not used. */ { + (void)dummy; DdeNameService(ddeInstance, NULL, 0, DNS_UNREGISTER); DdeUninitialize(ddeInstance); ddeInstance = 0; @@ -993,14 +1018,14 @@ DdeExitProc( static int MakeDdeConnection( Tcl_Interp *interp, /* Used to report errors. */ - const TCHAR *name, /* The connection to use. */ + const WCHAR *name, /* The connection to use. */ HCONV *ddeConvPtr) { HSZ ddeTopic, ddeService; HCONV ddeConv; - ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, CP_WINUNICODE); - ddeTopic = DdeCreateStringHandle(ddeInstance, name, CP_WINUNICODE); + ddeService = DdeCreateStringHandleW(ddeInstance, TCL_DDE_SERVICE_NAME, CP_WINUNICODE); + ddeTopic = DdeCreateStringHandleW(ddeInstance, name, CP_WINUNICODE); ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); @@ -1010,7 +1035,8 @@ MakeDdeConnection( if (interp != NULL) { Tcl_DString dString; - Tcl_WinTCharToUtf(name, -1, &dString); + Tcl_DStringInit(&dString); + Tcl_WCharToUtfDString(name, wcslen(name), &dString); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "no registered server named \"%s\"", Tcl_DStringValue(&dString))); Tcl_DStringFree(&dString); @@ -1047,9 +1073,9 @@ static int DdeCreateClient( DdeEnumServices *es) { - WNDCLASSEX wc; - static const TCHAR *szDdeClientClassName = TEXT("TclEval client class"); - static const TCHAR *szDdeClientWindowName = TEXT("TclEval client window"); + WNDCLASSEXW wc; + static const WCHAR *szDdeClientClassName = L"TclEval client class"; + static const WCHAR *szDdeClientWindowName = L"TclEval client window"; memset(&wc, 0, sizeof(wc)); wc.cbSize = sizeof(wc); @@ -1061,8 +1087,8 @@ DdeCreateClient( * Register and create the callback window. */ - RegisterClassEx(&wc); - es->hwnd = CreateWindowEx(0, szDdeClientClassName, szDdeClientWindowName, + RegisterClassExW(&wc); + es->hwnd = CreateWindowExW(0, szDdeClientClassName, szDdeClientWindowName, WS_POPUP, 0, 0, 0, 0, NULL, NULL, NULL, (LPVOID)es); return TCL_OK; } @@ -1081,16 +1107,16 @@ DdeClientWindowProc( (DdeEnumServices *) lpcs->lpCreateParams; #ifdef _WIN64 - SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR) es); + SetWindowLongPtrW(hwnd, GWLP_USERDATA, (LONG_PTR) es); #else - SetWindowLong(hwnd, GWL_USERDATA, (LONG) es); + SetWindowLongW(hwnd, GWL_USERDATA, (LONG) es); #endif return (LRESULT) 0L; } case WM_DDE_ACK: return DdeServicesOnAck(hwnd, wParam, lParam); default: - return DefWindowProc(hwnd, uMsg, wParam, lParam); + return DefWindowProcW(hwnd, uMsg, wParam, lParam); } } @@ -1104,13 +1130,13 @@ DdeServicesOnAck( ATOM service = (ATOM)LOWORD(lParam); ATOM topic = (ATOM)HIWORD(lParam); DdeEnumServices *es; - TCHAR sz[255]; + WCHAR sz[255]; Tcl_DString dString; #ifdef _WIN64 - es = (DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA); + es = (DdeEnumServices *) GetWindowLongPtrW(hwnd, GWLP_USERDATA); #else - es = (DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA); + es = (DdeEnumServices *) GetWindowLongW(hwnd, GWL_USERDATA); #endif if (((es->service == (ATOM)0) || (es->service == service)) @@ -1118,12 +1144,14 @@ DdeServicesOnAck( Tcl_Obj *matchPtr = Tcl_NewListObj(0, NULL); Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp); - GlobalGetAtomName(service, sz, 255); - Tcl_WinTCharToUtf(sz, -1, &dString); + GlobalGetAtomNameW(service, sz, 255); + Tcl_DStringInit(&dString); + Tcl_WCharToUtfDString(sz, wcslen(sz), &dString); Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1)); Tcl_DStringFree(&dString); - GlobalGetAtomName(topic, sz, 255); - Tcl_WinTCharToUtf(sz, -1, &dString); + GlobalGetAtomNameW(topic, sz, 255); + Tcl_DStringInit(&dString); + Tcl_WCharToUtfDString(sz, wcslen(sz), &dString); Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1)); Tcl_DStringFree(&dString); @@ -1151,7 +1179,7 @@ DdeServicesOnAck( * Tell the server we are no longer interested. */ - PostMessage(hwndRemote, WM_DDE_TERMINATE, (WPARAM)hwnd, 0L); + PostMessageW(hwndRemote, WM_DDE_TERMINATE, (WPARAM)hwnd, 0L); return 0L; } @@ -1163,7 +1191,7 @@ DdeEnumWindowsCallback( DWORD_PTR dwResult = 0; DdeEnumServices *es = (DdeEnumServices *) lParam; - SendMessageTimeout(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd, + SendMessageTimeoutW(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd, MAKELONG(es->service, es->topic), SMTO_ABORTIFHUNG, 1000, &dwResult); return TRUE; @@ -1172,16 +1200,16 @@ DdeEnumWindowsCallback( static int DdeGetServicesList( Tcl_Interp *interp, - const TCHAR *serviceName, - const TCHAR *topicName) + const WCHAR *serviceName, + const WCHAR *topicName) { DdeEnumServices es; es.interp = interp; es.result = TCL_OK; es.service = (serviceName == NULL) - ? (ATOM)0 : GlobalAddAtom(serviceName); - es.topic = (topicName == NULL) ? (ATOM)0 : GlobalAddAtom(topicName); + ? (ATOM)0 : GlobalAddAtomW(serviceName); + es.topic = (topicName == NULL) ? (ATOM)0 : GlobalAddAtomW(topicName); Tcl_ResetResult(interp); /* our list is to be appended to result. */ DdeCreateClient(&es); @@ -1265,7 +1293,7 @@ SetDdeError( static int DdeObjCmd( - ClientData clientData, /* Used only for deletion */ + void *dummy, /* Not used. */ Tcl_Interp *interp, /* The interp we are sending from */ int objc, /* Number of arguments */ Tcl_Obj *const *objv) /* The arguments */ @@ -1302,11 +1330,12 @@ DdeObjCmd( HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL; HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn; HCONV hConv = NULL; - const TCHAR *serviceName = NULL, *topicName = NULL; + const WCHAR *serviceName = NULL, *topicName = NULL; const char *string; DWORD ddeResult; Tcl_Obj *objPtr, *handlerPtr = NULL; Tcl_DString serviceBuf, topicBuf, itemBuf; + (void)dummy; /* * Initialize DDE server/client @@ -1462,9 +1491,10 @@ DdeObjCmd( const char *src = Tcl_GetString(objv[firstArg]); length = objv[firstArg]->length; - Tcl_WinUtfToTChar(src, length, &serviceBuf); - serviceName = (TCHAR *) Tcl_DStringValue(&serviceBuf); - length = Tcl_DStringLength(&serviceBuf) / sizeof(TCHAR); + Tcl_DStringInit(&serviceBuf); + Tcl_UtfToWCharDString(src, length, &serviceBuf); + serviceName = (WCHAR *) Tcl_DStringValue(&serviceBuf); + length = Tcl_DStringLength(&serviceBuf) / sizeof(WCHAR); } else { length = 0; } @@ -1472,7 +1502,7 @@ DdeObjCmd( if (length == 0) { serviceName = NULL; } else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { - ddeService = DdeCreateStringHandle(ddeInstance, (void *) serviceName, + ddeService = DdeCreateStringHandleW(ddeInstance, serviceName, CP_WINUNICODE); } @@ -1480,12 +1510,13 @@ DdeObjCmd( const char *src = Tcl_GetString(objv[firstArg + 1]); length = objv[firstArg + 1]->length; - topicName = Tcl_WinUtfToTChar(src, length, &topicBuf); - length = Tcl_DStringLength(&topicBuf) / sizeof(TCHAR); + Tcl_DStringInit(&topicBuf); + topicName = Tcl_UtfToWCharDString(src, length, &topicBuf); + length = Tcl_DStringLength(&topicBuf) / sizeof(WCHAR); if (length == 0) { topicName = NULL; } else { - ddeTopic = DdeCreateStringHandle(ddeInstance, (void *) topicName, + ddeTopic = DdeCreateStringHandleW(ddeInstance, topicName, CP_WINUNICODE); } } @@ -1497,7 +1528,8 @@ DdeObjCmd( if (serviceName != NULL) { Tcl_DString dsBuf; - Tcl_WinTCharToUtf(serviceName, -1, &dsBuf); + Tcl_DStringInit(&dsBuf); + Tcl_WCharToUtfDString(serviceName, wcslen(serviceName), &dsBuf); Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_DStringValue(&dsBuf), Tcl_DStringLength(&dsBuf))); Tcl_DStringFree(&dsBuf); @@ -1520,9 +1552,10 @@ DdeObjCmd( src = Tcl_GetString(objv[firstArg + 2]); dataLength = objv[firstArg + 2]->length; - dataString = (const TCHAR *) - Tcl_WinUtfToTChar(src, dataLength, &dsBuf); - dataLength = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR); + Tcl_DStringInit(&dsBuf); + dataString = + Tcl_UtfToWCharDString(src, dataLength, &dsBuf); + dataLength = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR); } if (dataLength + 1 < 2) { @@ -1568,13 +1601,14 @@ DdeObjCmd( break; } case DDE_REQUEST: { - const TCHAR *itemString; + const WCHAR *itemString; const char *src; src = Tcl_GetString(objv[firstArg + 2]); length = objv[firstArg + 2]->length; - itemString = Tcl_WinUtfToTChar(src, length, &itemBuf); - length = Tcl_DStringLength(&itemBuf) / sizeof(TCHAR); + Tcl_DStringInit(&itemBuf); + itemString = Tcl_UtfToWCharDString(src, length, &itemBuf); + length = Tcl_DStringLength(&itemBuf) / sizeof(WCHAR); if (length == 0) { Tcl_SetObjResult(interp, @@ -1592,7 +1626,7 @@ DdeObjCmd( result = TCL_ERROR; } else { Tcl_Obj *returnObjPtr; - ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString, + ddeItem = DdeCreateStringHandleW(ddeInstance, itemString, CP_WINUNICODE); if (ddeItem != NULL) { ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem, @@ -1602,7 +1636,7 @@ DdeObjCmd( result = TCL_ERROR; } else { DWORD tmp; - TCHAR *dataString = (TCHAR *) DdeAccessData(ddeData, &tmp); + WCHAR *dataString = (WCHAR *) DdeAccessData(ddeData, &tmp); if (flags & DDE_FLAG_BINARY) { returnObjPtr = @@ -1610,11 +1644,12 @@ DdeObjCmd( } else { Tcl_DString dsBuf; - if ((tmp >= sizeof(TCHAR)) - && !dataString[tmp / sizeof(TCHAR) - 1]) { - tmp -= sizeof(TCHAR); + if ((tmp >= sizeof(WCHAR)) + && !dataString[tmp / sizeof(WCHAR) - 1]) { + tmp -= sizeof(WCHAR); } - Tcl_WinTCharToUtf(dataString, tmp, &dsBuf); + Tcl_DStringInit(&dsBuf); + Tcl_WCharToUtfDString(dataString, tmp>>1, &dsBuf); returnObjPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf), Tcl_DStringLength(&dsBuf)); @@ -1633,14 +1668,15 @@ DdeObjCmd( } case DDE_POKE: { Tcl_DString dsBuf; - const TCHAR *itemString; + const WCHAR *itemString; BYTE *dataString; const char *src; src = Tcl_GetString(objv[firstArg + 2]); length = objv[firstArg + 2]->length; - itemString = Tcl_WinUtfToTChar(src, length, &itemBuf); - length = Tcl_DStringLength(&itemBuf) / sizeof(TCHAR); + Tcl_DStringInit(&itemBuf); + itemString = Tcl_UtfToWCharDString(src, length, &itemBuf); + length = Tcl_DStringLength(&itemBuf) / sizeof(WCHAR); if (length == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot have a null item", -1)); @@ -1656,9 +1692,10 @@ DdeObjCmd( const char *data = Tcl_GetString(objv[firstArg + 3]); length = objv[firstArg + 3]->length; + Tcl_DStringInit(&dsBuf); dataString = (BYTE *) - Tcl_WinUtfToTChar(data, length, &dsBuf); - length = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR); + Tcl_UtfToWCharDString(data, length, &dsBuf); + length = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR); } hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); @@ -1669,7 +1706,7 @@ DdeObjCmd( SetDdeError(interp); result = TCL_ERROR; } else { - ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString, + ddeItem = DdeCreateStringHandleW(ddeInstance, itemString, CP_WINUNICODE); if (ddeItem != NULL) { ddeData = DdeClientTransaction(dataString, (DWORD) length, @@ -1717,7 +1754,7 @@ DdeObjCmd( for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (_tcsicmp(serviceName, riPtr->name) == 0) { + if (_wcsicmp(serviceName, riPtr->name) == 0) { break; } } @@ -1820,9 +1857,10 @@ DdeObjCmd( objPtr = Tcl_ConcatObj(objc, objv); string = Tcl_GetString(objPtr); length = objPtr->length; - Tcl_WinUtfToTChar(string, length, &dsBuf); + Tcl_DStringInit(&dsBuf); + Tcl_UtfToWCharDString(string, length, &dsBuf); string = Tcl_DStringValue(&dsBuf); - length = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR); + length = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR); ddeItemData = DdeCreateDataHandle(ddeInstance, (BYTE *) string, (DWORD) length, 0, 0, CF_UNICODETEXT, 0); Tcl_DStringFree(&dsBuf); @@ -1837,7 +1875,7 @@ DdeObjCmd( 0xFFFFFFFF, hConv, 0, CF_UNICODETEXT, XTYP_EXECUTE, 30000, NULL); if (ddeData != 0) { - ddeCookie = DdeCreateStringHandle(ddeInstance, + ddeCookie = DdeCreateStringHandleW(ddeInstance, TCL_DDE_EXECUTE_RESULT, CP_WINUNICODE); ddeData = DdeClientTransaction(NULL, 0, hConv, ddeCookie, CF_UNICODETEXT, XTYP_REQUEST, 30000, NULL); @@ -1854,7 +1892,7 @@ DdeObjCmd( if (!(flags & DDE_FLAG_ASYNC)) { Tcl_Obj *resultPtr; - TCHAR *ddeDataString; + WCHAR *ddeDataString; /* * The return handle has a two or four element list in it. The @@ -1866,12 +1904,13 @@ DdeObjCmd( */ length = DdeGetData(ddeData, NULL, 0, 0); - ddeDataString = (TCHAR *) Tcl_Alloc(length); + ddeDataString = (WCHAR *) Tcl_Alloc(length); DdeGetData(ddeData, (BYTE *) ddeDataString, (DWORD) length, 0); - if (length > sizeof(TCHAR)) { - length -= sizeof(TCHAR); + if (length > sizeof(WCHAR)) { + length -= sizeof(WCHAR); } - Tcl_WinTCharToUtf(ddeDataString, length, &dsBuf); + Tcl_DStringInit(&dsBuf); + Tcl_WCharToUtfDString(ddeDataString, length>>1, &dsBuf); resultPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf), Tcl_DStringLength(&dsBuf)); Tcl_DStringFree(&dsBuf); diff --git a/win/tclWinReg.c b/win/tclWinReg.c index f93a553..068e5d7 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -94,7 +94,7 @@ static void AppendSystemError(Tcl_Interp *interp, DWORD error); static int BroadcastValue(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static DWORD ConvertDWORD(DWORD type, DWORD value); -static void DeleteCmd(ClientData clientData); +static void DeleteCmd(void *clientData); static int DeleteKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj, REGSAM mode); static int DeleteValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, @@ -116,14 +116,24 @@ static int ParseKeyName(Tcl_Interp *interp, char *name, char **hostNamePtr, HKEY *rootKeyPtr, char **keyNamePtr); static DWORD RecursiveDeleteKey(HKEY hStartKey, - const TCHAR * pKeyName, REGSAM mode); -static int RegistryObjCmd(ClientData clientData, + const WCHAR * pKeyName, REGSAM mode); +static int RegistryObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj, Tcl_Obj *dataObj, Tcl_Obj *typeObj, REGSAM mode); +#if (TCL_MAJOR_VERSION < 9) && (TCL_MINOR_VERSION < 7) +# if TCL_UTF_MAX > 3 +# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf(a,(b)*sizeof(WCHAR),c) +# define Tcl_UtfToWCharDString(a,b,c) Tcl_WinUtfToTChar(a,b,c) +# else +# define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString +# define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString +# endif +#endif + static unsigned char * getByteArrayFromObj( Tcl_Obj *objPtr, @@ -143,8 +153,14 @@ getByteArrayFromObj( return result; } +#ifdef __cplusplus +extern "C" { +#endif DLLEXPORT int Registry_Init(Tcl_Interp *interp); DLLEXPORT int Registry_Unload(Tcl_Interp *interp, int flags); +#ifdef __cplusplus +} +#endif /* *---------------------------------------------------------------------- @@ -168,14 +184,14 @@ Registry_Init( { Tcl_Command cmd; - if (Tcl_InitStubs(interp, "8.5", 0) == NULL) { + if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, interp, DeleteCmd); Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd); - return Tcl_PkgProvide(interp, "registry", "1.3.3"); + return Tcl_PkgProvideEx(interp, "registry", "1.3.3", NULL); } /* @@ -201,6 +217,7 @@ Registry_Unload( { Tcl_Command cmd; Tcl_Obj *objv[3]; + (void)flags; /* * Unregister the registry package. There is no Tcl_PkgForget() @@ -215,7 +232,7 @@ Registry_Unload( * Delete the originally registered command. */ - cmd = Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL); + cmd = (Tcl_Command)Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL); if (cmd != NULL) { Tcl_DeleteCommandFromToken(interp, cmd); } @@ -242,9 +259,9 @@ Registry_Unload( static void DeleteCmd( - ClientData clientData) + void *clientData) { - Tcl_Interp *interp = clientData; + Tcl_Interp *interp = (Tcl_Interp *)clientData; Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, NULL); } @@ -267,7 +284,7 @@ DeleteCmd( static int RegistryObjCmd( - ClientData clientData, /* Not used. */ + void *dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ @@ -286,6 +303,7 @@ RegistryObjCmd( static const char *const modes[] = { "-32bit", "-64bit", NULL }; + (void)dummy; if (objc < 2) { wrongArgs: @@ -415,7 +433,7 @@ DeleteKey( REGSAM mode) /* Mode flags to pass. */ { char *tail, *buffer, *hostName, *keyName; - const TCHAR *nativeTail; + const WCHAR *nativeTail; HKEY rootKey, subkey; DWORD result; Tcl_DString buf; @@ -468,7 +486,8 @@ DeleteKey( * Now we recursively delete the key and everything below it. */ - nativeTail = Tcl_WinUtfToTChar(tail, -1, &buf); + Tcl_DStringInit(&buf); + nativeTail = Tcl_UtfToWCharDString(tail, -1, &buf); result = RecursiveDeleteKey(subkey, nativeTail, saveMode); Tcl_DStringFree(&buf); @@ -524,8 +543,9 @@ DeleteValue( } valueName = Tcl_GetString(valueNameObj); - Tcl_WinUtfToTChar(valueName, valueNameObj->length, &ds); - result = RegDeleteValue(key, (const TCHAR *)Tcl_DStringValue(&ds)); + Tcl_DStringInit(&ds); + Tcl_UtfToWCharDString(valueName, valueNameObj->length, &ds); + result = RegDeleteValueW(key, (const WCHAR *)Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -568,7 +588,7 @@ GetKeyNames( { const char *pattern; /* Pattern being matched against subkeys */ HKEY key; /* Handle to the key being examined */ - TCHAR buffer[MAX_KEY_LENGTH]; + WCHAR buffer[MAX_KEY_LENGTH]; /* Buffer to hold the subkey name */ DWORD bufSize; /* Size of the buffer */ DWORD index; /* Position of the current subkey */ @@ -599,7 +619,7 @@ GetKeyNames( resultPtr = Tcl_NewObj(); for (index = 0;; ++index) { bufSize = MAX_KEY_LENGTH; - result = RegEnumKeyEx(key, index, buffer, &bufSize, + result = RegEnumKeyExW(key, index, buffer, &bufSize, NULL, NULL, NULL, NULL); if (result != ERROR_SUCCESS) { if (result == ERROR_NO_MORE_ITEMS) { @@ -613,7 +633,8 @@ GetKeyNames( } break; } - name = Tcl_WinTCharToUtf(buffer, bufSize * sizeof(TCHAR), &ds); + Tcl_DStringInit(&ds); + name = Tcl_WCharToUtfDString(buffer, bufSize, &ds); if (pattern && !Tcl_StringMatch(name, pattern)) { Tcl_DStringFree(&ds); continue; @@ -663,7 +684,7 @@ GetType( DWORD result, type; Tcl_DString ds; const char *valueName; - const TCHAR *nativeValue; + const WCHAR *nativeValue; /* * Attempt to open the key for reading. @@ -679,8 +700,9 @@ GetType( */ valueName = Tcl_GetString(valueNameObj); - nativeValue = Tcl_WinUtfToTChar(valueName, valueNameObj->length, &ds); - result = RegQueryValueEx(key, nativeValue, NULL, &type, + Tcl_DStringInit(&ds); + nativeValue = Tcl_UtfToWCharDString(valueName, valueNameObj->length, &ds); + result = RegQueryValueExW(key, nativeValue, NULL, &type, NULL, NULL); Tcl_DStringFree(&ds); RegCloseKey(key); @@ -732,7 +754,7 @@ GetValue( { HKEY key; const char *valueName; - const TCHAR *nativeValue; + const WCHAR *nativeValue; DWORD result, length, type; Tcl_DString data, buf; @@ -757,12 +779,13 @@ GetValue( Tcl_DStringInit(&data); Tcl_DStringSetLength(&data, TCL_DSTRING_STATIC_SIZE - 1); - length = TCL_DSTRING_STATIC_SIZE/sizeof(TCHAR) - 1; + length = TCL_DSTRING_STATIC_SIZE/sizeof(WCHAR) - 1; valueName = Tcl_GetString(valueNameObj); - nativeValue = Tcl_WinUtfToTChar(valueName, valueNameObj->length, &buf); + Tcl_DStringInit(&buf); + nativeValue = Tcl_UtfToWCharDString(valueName, valueNameObj->length, &buf); - result = RegQueryValueEx(key, nativeValue, NULL, &type, + result = RegQueryValueExW(key, nativeValue, NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length); while (result == ERROR_MORE_DATA) { /* @@ -771,9 +794,9 @@ GetValue( * HKEY_PERFORMANCE_DATA */ - length = Tcl_DStringLength(&data) * (2 / sizeof(TCHAR)); - Tcl_DStringSetLength(&data, (int) length * sizeof(TCHAR)); - result = RegQueryValueEx(key, nativeValue, + length = Tcl_DStringLength(&data) * (2 / sizeof(WCHAR)); + Tcl_DStringSetLength(&data, (int) length * sizeof(WCHAR)); + result = RegQueryValueExW(key, nativeValue, NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length); } Tcl_DStringFree(&buf); @@ -809,13 +832,13 @@ GetValue( */ while ((p < end) && *((WCHAR *) p) != 0) { - WCHAR *wp; + WCHAR *wp = (WCHAR *) p; - Tcl_WinTCharToUtf((TCHAR *) p, -1, &buf); + Tcl_DStringInit(&buf); + Tcl_WCharToUtfDString(wp, wcslen(wp), &buf); Tcl_ListObjAppendElement(interp, resultPtr, Tcl_NewStringObj(Tcl_DStringValue(&buf), Tcl_DStringLength(&buf))); - wp = (WCHAR *) p; while (*wp++ != 0) {/* empty body */} p = (char *) wp; @@ -823,7 +846,9 @@ GetValue( } Tcl_SetObjResult(interp, resultPtr); } else if ((type == REG_SZ) || (type == REG_EXPAND_SZ)) { - Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&data), -1, &buf); + WCHAR *wp = (WCHAR *) Tcl_DStringValue(&data); + Tcl_DStringInit(&buf); + Tcl_WCharToUtfDString((const WCHAR *)Tcl_DStringValue(&data), wcslen(wp), &buf); Tcl_DStringResult(interp, &buf); } else { /* @@ -880,7 +905,7 @@ GetValueNames( resultPtr = Tcl_NewObj(); Tcl_DStringInit(&buffer); - Tcl_DStringSetLength(&buffer, (int) (MAX_KEY_LENGTH * sizeof(TCHAR))); + Tcl_DStringSetLength(&buffer, (int) (MAX_KEY_LENGTH * sizeof(WCHAR))); index = 0; result = TCL_OK; @@ -897,12 +922,11 @@ GetValueNames( */ size = MAX_KEY_LENGTH; - while (RegEnumValue(key,index, (TCHAR *)Tcl_DStringValue(&buffer), + while (RegEnumValueW(key,index, (WCHAR *)Tcl_DStringValue(&buffer), &size, NULL, NULL, NULL, NULL) == ERROR_SUCCESS) { - size *= sizeof(TCHAR); - Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), (int) size, - &ds); + Tcl_DStringInit(&ds); + Tcl_WCharToUtfDString((const WCHAR *)Tcl_DStringValue(&buffer), size, &ds); name = Tcl_DStringValue(&ds); if (!pattern || Tcl_StringMatch(name, pattern)) { result = Tcl_ListObjAppendElement(interp, resultPtr, @@ -1008,8 +1032,9 @@ OpenSubKey( */ if (hostName) { - hostName = (char *) Tcl_WinUtfToTChar(hostName, -1, &buf); - result = RegConnectRegistry((TCHAR *)hostName, rootKey, + Tcl_DStringInit(&buf); + hostName = (char *) Tcl_UtfToWCharDString(hostName, -1, &buf); + result = RegConnectRegistryW((WCHAR *)hostName, rootKey, &rootKey); Tcl_DStringFree(&buf); if (result != ERROR_SUCCESS) { @@ -1023,12 +1048,13 @@ OpenSubKey( */ if (keyName) { - keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf); + Tcl_DStringInit(&buf); + keyName = (char *) Tcl_UtfToWCharDString(keyName, -1, &buf); } if (flags & REG_CREATE) { DWORD create; - result = RegCreateKeyEx(rootKey, (TCHAR *)keyName, 0, NULL, + result = RegCreateKeyExW(rootKey, (WCHAR *)keyName, 0, NULL, REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create); } else if (rootKey == HKEY_PERFORMANCE_DATA) { /* @@ -1039,7 +1065,7 @@ OpenSubKey( *keyPtr = HKEY_PERFORMANCE_DATA; result = ERROR_SUCCESS; } else { - result = RegOpenKeyEx(rootKey, (TCHAR *)keyName, 0, mode, + result = RegOpenKeyExW(rootKey, (WCHAR *)keyName, 0, mode, keyPtr); } if (keyName) { @@ -1159,7 +1185,7 @@ ParseKeyName( static DWORD RecursiveDeleteKey( HKEY startKey, /* Parent of key to be deleted. */ - const TCHAR *keyName, /* Name of key to be deleted in external + const WCHAR *keyName, /* Name of key to be deleted in external * encoding, not UTF. */ REGSAM mode) /* Mode flags to pass. */ { @@ -1168,7 +1194,7 @@ RecursiveDeleteKey( HKEY hKey; REGSAM saveMode = mode; static int checkExProc = 0; - static FARPROC regDeleteKeyExProc = NULL; + static LSTATUS (* regDeleteKeyExProc) (HKEY, LPCWSTR, REGSAM, DWORD) = (LSTATUS (*) (HKEY, LPCWSTR, REGSAM, DWORD)) NULL; /* * Do not allow NULL or empty key name. @@ -1179,13 +1205,13 @@ RecursiveDeleteKey( } mode |= KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE; - result = RegOpenKeyEx(startKey, keyName, 0, mode, &hKey); + result = RegOpenKeyExW(startKey, keyName, 0, mode, &hKey); if (result != ERROR_SUCCESS) { return result; } Tcl_DStringInit(&subkey); - Tcl_DStringSetLength(&subkey, (int) (MAX_KEY_LENGTH * sizeof(TCHAR))); + Tcl_DStringSetLength(&subkey, (int) (MAX_KEY_LENGTH * sizeof(WCHAR))); mode = saveMode; while (result == ERROR_SUCCESS) { @@ -1194,7 +1220,7 @@ RecursiveDeleteKey( */ size = MAX_KEY_LENGTH; - result = RegEnumKeyEx(hKey, 0, (TCHAR *)Tcl_DStringValue(&subkey), + result = RegEnumKeyExW(hKey, 0, (WCHAR *)Tcl_DStringValue(&subkey), &size, NULL, NULL, NULL, NULL); if (result == ERROR_NO_MORE_ITEMS) { /* @@ -1207,19 +1233,19 @@ RecursiveDeleteKey( HMODULE handle; checkExProc = 1; - handle = GetModuleHandle(TEXT("ADVAPI32")); - regDeleteKeyExProc = (FARPROC) + handle = GetModuleHandleW(L"ADVAPI32"); + regDeleteKeyExProc = (LSTATUS (*) (HKEY, LPCWSTR, REGSAM, DWORD)) GetProcAddress(handle, "RegDeleteKeyExW"); } if (mode && regDeleteKeyExProc) { result = regDeleteKeyExProc(startKey, keyName, mode, 0); } else { - result = RegDeleteKey(startKey, keyName); + result = RegDeleteKeyW(startKey, keyName); } break; } else if (result == ERROR_SUCCESS) { result = RecursiveDeleteKey(hKey, - (const TCHAR *) Tcl_DStringValue(&subkey), mode); + (const WCHAR *) Tcl_DStringValue(&subkey), mode); } } Tcl_DStringFree(&subkey); @@ -1275,7 +1301,8 @@ SetValue( } valueName = Tcl_GetString(valueNameObj); - valueName = (char *) Tcl_WinUtfToTChar(valueName, valueNameObj->length, &nameBuf); + Tcl_DStringInit(&nameBuf); + valueName = (char *) Tcl_UtfToWCharDString(valueName, valueNameObj->length, &nameBuf); if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) { int value; @@ -1287,7 +1314,7 @@ SetValue( } value = ConvertDWORD((DWORD) type, (DWORD) value); - result = RegSetValueEx(key, (TCHAR *) valueName, 0, + result = RegSetValueExW(key, (WCHAR *) valueName, 0, (DWORD) type, (BYTE *) &value, sizeof(DWORD)); } else if (type == REG_MULTI_SZ) { Tcl_DString data, buf; @@ -1319,9 +1346,10 @@ SetValue( Tcl_DStringAppend(&data, "", 1); /* NUL-terminated string */ } - Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1, + Tcl_DStringInit(&buf); + Tcl_UtfToWCharDString(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1, &buf); - result = RegSetValueEx(key, (TCHAR *) valueName, 0, + result = RegSetValueExW(key, (WCHAR *) valueName, 0, (DWORD) type, (BYTE *) Tcl_DStringValue(&buf), (DWORD) Tcl_DStringLength(&buf)); Tcl_DStringFree(&data); @@ -1330,7 +1358,8 @@ SetValue( Tcl_DString buf; const char *data = Tcl_GetString(dataObj); - data = (char *) Tcl_WinUtfToTChar(data, dataObj->length, &buf); + Tcl_DStringInit(&buf); + data = (char *) Tcl_UtfToWCharDString(data, dataObj->length, &buf); /* * Include the null in the length, padding if needed for WCHAR. @@ -1338,7 +1367,7 @@ SetValue( Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1); - result = RegSetValueEx(key, (TCHAR *) valueName, 0, + result = RegSetValueExW(key, (WCHAR *) valueName, 0, (DWORD) type, (BYTE *) data, (DWORD) Tcl_DStringLength(&buf) + 1); Tcl_DStringFree(&buf); } else { @@ -1350,7 +1379,7 @@ SetValue( */ data = (BYTE *) getByteArrayFromObj(dataObj, &bytelength); - result = RegSetValueEx(key, (TCHAR *) valueName, 0, + result = RegSetValueExW(key, (WCHAR *) valueName, 0, (DWORD) type, data, (DWORD) bytelength); } @@ -1410,7 +1439,8 @@ BroadcastValue( } str = Tcl_GetString(objv[0]); - wstr = (WCHAR *) Tcl_WinUtfToTChar(str, objv[0]->length, &ds); + Tcl_DStringInit(&ds); + wstr = Tcl_UtfToWCharDString(str, objv[0]->length, &ds); if (Tcl_DStringLength(&ds) == 0) { wstr = NULL; } @@ -1419,7 +1449,7 @@ BroadcastValue( * Use the ignore the result. */ - result = SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, + result = SendMessageTimeoutW(HWND_BROADCAST, WM_SETTINGCHANGE, (WPARAM) 0, (LPARAM) wstr, SMTO_ABORTIFHUNG, (UINT) timeout, &sendResult); Tcl_DStringFree(&ds); @@ -1454,7 +1484,7 @@ AppendSystemError( DWORD error) /* Result code from error. */ { int length; - TCHAR *tMsgPtr, **tMsgPtrPtr = &tMsgPtr; + WCHAR *tMsgPtr, **tMsgPtrPtr = &tMsgPtr; const char *msg; char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE]; Tcl_DString ds; @@ -1463,9 +1493,9 @@ AppendSystemError( if (Tcl_IsShared(resultPtr)) { resultPtr = Tcl_DuplicateObj(resultPtr); } - length = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM + length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error, - MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (TCHAR *) tMsgPtrPtr, + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) tMsgPtrPtr, 0, NULL); if (length == 0) { sprintf(msgBuf, "unknown error: %ld", error); @@ -1473,7 +1503,8 @@ AppendSystemError( } else { char *msgPtr; - Tcl_WinTCharToUtf(tMsgPtr, -1, &ds); + Tcl_DStringInit(&ds); + Tcl_WCharToUtfDString(tMsgPtr, wcslen(tMsgPtr), &ds); LocalFree(tMsgPtr); msgPtr = Tcl_DStringValue(&ds); -- cgit v0.12 From 0a6728c33d79445c6e4fc81ab9c78f2aa1f2cd82 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 20 Sep 2019 21:01:44 +0000 Subject: Let's use GetWindowLongW/SetWindowLongW on Win32 directly. Missed them because they are not used in Win64. --- win/tclWinConsole.c | 10 ++++------ win/tclWinPipe.c | 2 +- win/tclWinSock.c | 4 ++-- 3 files changed, 7 insertions(+), 9 deletions(-) diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index 449bea9..173fe9e 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -208,7 +208,6 @@ ReadConsoleBytes( { DWORD ntchars; BOOL result; - int tcharsize = sizeof(WCHAR); /* * If user types a Ctrl-Break or Ctrl-C, ReadConsole will return @@ -221,11 +220,11 @@ ReadConsoleBytes( * will run and take whatever action it deems appropriate. */ do { - result = ReadConsoleW(hConsole, lpBuffer, nbytes / tcharsize, &ntchars, + result = ReadConsoleW(hConsole, lpBuffer, nbytes / sizeof(WCHAR), &ntchars, NULL); } while (result && ntchars == 0 && GetLastError() == ERROR_OPERATION_ABORTED); if (nbytesread != NULL) { - *nbytesread = ntchars * tcharsize; + *nbytesread = ntchars * sizeof(WCHAR); } return result; } @@ -239,12 +238,11 @@ WriteConsoleBytes( { DWORD ntchars; BOOL result; - int tcharsize = sizeof(WCHAR); - result = WriteConsoleW(hConsole, lpBuffer, nbytes / tcharsize, &ntchars, + result = WriteConsoleW(hConsole, lpBuffer, nbytes / sizeof(WCHAR), &ntchars, NULL); if (nbyteswritten != NULL) { - *nbyteswritten = ntchars * tcharsize; + *nbyteswritten = ntchars * sizeof(WCHAR); } return result; } diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 191545b..6120358 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -1221,7 +1221,7 @@ HasConsole(void) { HANDLE handle; - handle = CreateFileA("CONOUT$", GENERIC_WRITE, FILE_SHARE_WRITE, + handle = CreateFileW(L"CONOUT$", GENERIC_WRITE, FILE_SHARE_WRITE, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); if (handle != INVALID_HANDLE_VALUE) { diff --git a/win/tclWinSock.c b/win/tclWinSock.c index ed633ef..a397a30 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -3063,7 +3063,7 @@ SocketProc( #ifdef _WIN64 GetWindowLongPtrW(hwnd, GWLP_USERDATA); #else - GetWindowLong(hwnd, GWL_USERDATA); + GetWindowLongW(hwnd, GWL_USERDATA); #endif switch (message) { @@ -3081,7 +3081,7 @@ SocketProc( SetWindowLongPtrW(hwnd, GWLP_USERDATA, (LONG_PTR) ((LPCREATESTRUCT)lParam)->lpCreateParams); #else - SetWindowLong(hwnd, GWL_USERDATA, + SetWindowLongW(hwnd, GWL_USERDATA, (LONG) ((LPCREATESTRUCT)lParam)->lpCreateParams); #endif break; -- cgit v0.12 From ee57084f052a28c9aa15273f05a9fc522fa14c9e Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 24 Sep 2019 20:01:06 +0000 Subject: namespace.test: add missing clean-up (allow repetition of test within -singleproc 1) --- tests/namespace.test | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/namespace.test b/tests/namespace.test index ad82abe..dd71697 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -2624,6 +2624,7 @@ test namespace-51.6 {name resolution path control} -body { namespace delete ::test_ns_1 catch {rename ::pathtestB {}} catch {rename ::pathtestD {}} + catch {rename ::pathtestC {}} } test namespace-51.7 {name resolution path control} -body { namespace eval ::test_ns_1 { -- cgit v0.12 From 03dea312bdab6082bc5814077935352dd2152f8d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 25 Sep 2019 11:54:18 +0000 Subject: (cherry-pick): Update TZ info to tzdata2019c. --- library/tzdata/America/Detroit | 5 + library/tzdata/America/Edmonton | 4 - library/tzdata/America/Indiana/Tell_City | 16 +-- library/tzdata/America/Kentucky/Louisville | 9 +- library/tzdata/America/Vancouver | 2 +- library/tzdata/Asia/Hong_Kong | 2 +- library/tzdata/Asia/Seoul | 8 ++ library/tzdata/Europe/Brussels | 2 +- library/tzdata/Europe/Istanbul | 57 ++++----- library/tzdata/Europe/Kaliningrad | 9 +- library/tzdata/Europe/Vienna | 2 +- library/tzdata/Pacific/Fiji | 186 ++++++++++++++--------------- library/tzdata/Pacific/Norfolk | 164 ++++++++++++++++++++++++- 13 files changed, 308 insertions(+), 158 deletions(-) diff --git a/library/tzdata/America/Detroit b/library/tzdata/America/Detroit index f725874..2139aa8 100644 --- a/library/tzdata/America/Detroit +++ b/library/tzdata/America/Detroit @@ -11,6 +11,11 @@ set TZData(:America/Detroit) { {-757364400 -18000 0 EST} {-684349200 -14400 1 EDT} {-671047200 -18000 0 EST} + {-80506740 -14400 0 EDT} + {-68666400 -18000 0 EST} + {-52938000 -14400 1 EDT} + {-37216800 -18000 0 EST} + {-31518000 -18000 0 EST} {94712400 -18000 0 EST} {104914800 -14400 1 EDT} {120636000 -18000 0 EST} diff --git a/library/tzdata/America/Edmonton b/library/tzdata/America/Edmonton index 1ed38be..234b3af 100644 --- a/library/tzdata/America/Edmonton +++ b/library/tzdata/America/Edmonton @@ -20,10 +20,6 @@ set TZData(:America/Edmonton) { {-765388800 -25200 0 MST} {-715791600 -21600 1 MDT} {-702489600 -25200 0 MST} - {-84380400 -21600 1 MDT} - {-68659200 -25200 0 MST} - {-21481200 -21600 1 MDT} - {-5760000 -25200 0 MST} {73472400 -21600 1 MDT} {89193600 -25200 0 MST} {104922000 -21600 1 MDT} diff --git a/library/tzdata/America/Indiana/Tell_City b/library/tzdata/America/Indiana/Tell_City index 9eebcf7..f8014bf 100644 --- a/library/tzdata/America/Indiana/Tell_City +++ b/library/tzdata/America/Indiana/Tell_City @@ -11,12 +11,6 @@ set TZData(:America/Indiana/Tell_City) { {-769395600 -18000 1 CPT} {-765392400 -21600 0 CST} {-757360800 -21600 0 CST} - {-747244800 -18000 1 CDT} - {-733942800 -21600 0 CST} - {-526492800 -18000 1 CDT} - {-513190800 -21600 0 CST} - {-495043200 -18000 1 CDT} - {-481741200 -21600 0 CST} {-462996000 -18000 1 CDT} {-450291600 -21600 0 CST} {-431539200 -18000 1 CDT} @@ -28,16 +22,18 @@ set TZData(:America/Indiana/Tell_City) { {-337190400 -18000 1 CDT} {-323888400 -21600 0 CST} {-305740800 -18000 1 CDT} - {-289414800 -21600 0 CST} + {-292438800 -21600 0 CST} {-273686400 -18000 1 CDT} - {-260989200 -21600 0 CST} + {-257965200 -21600 0 CST} {-242236800 -18000 1 CDT} {-226515600 -21600 0 CST} {-210787200 -18000 1 CDT} {-195066000 -21600 0 CST} {-179337600 -18000 0 EST} - {-31518000 -18000 0 EST} - {-21488400 -14400 1 EDT} + {-68662800 -21600 0 CST} + {-52934400 -18000 1 CDT} + {-37213200 -21600 0 CST} + {-21484800 -14400 0 EDT} {-5767200 -18000 0 EST} {9961200 -14400 1 EDT} {25682400 -18000 0 EST} diff --git a/library/tzdata/America/Kentucky/Louisville b/library/tzdata/America/Kentucky/Louisville index c2aa10c..7efbec9 100644 --- a/library/tzdata/America/Kentucky/Louisville +++ b/library/tzdata/America/Kentucky/Louisville @@ -17,12 +17,9 @@ set TZData(:America/Kentucky/Louisville) { {-769395600 -18000 1 CPT} {-765392400 -21600 0 CST} {-757360800 -21600 0 CST} - {-747244800 -18000 1 CDT} + {-747251940 -18000 1 CDT} {-744224400 -21600 0 CST} - {-715795200 -18000 1 CDT} - {-684349200 -18000 1 CDT} - {-652899600 -18000 1 CDT} - {-620845200 -18000 1 CDT} + {-620841600 -18000 1 CDT} {-608144400 -21600 0 CST} {-589392000 -18000 1 CDT} {-576090000 -21600 0 CST} @@ -45,7 +42,7 @@ set TZData(:America/Kentucky/Louisville) { {-305740800 -18000 1 CDT} {-289414800 -21600 0 CST} {-273686400 -18000 1 CDT} - {-266432400 -18000 0 EST} + {-266428800 -18000 0 EST} {-63140400 -18000 0 EST} {-52938000 -14400 1 EDT} {-37216800 -18000 0 EST} diff --git a/library/tzdata/America/Vancouver b/library/tzdata/America/Vancouver index aef639a..795e9e0 100644 --- a/library/tzdata/America/Vancouver +++ b/library/tzdata/America/Vancouver @@ -9,7 +9,7 @@ set TZData(:America/Vancouver) { {-769395600 -25200 1 PPT} {-765385200 -28800 0 PST} {-747237600 -25200 1 PDT} - {-732726000 -28800 0 PST} + {-733935600 -28800 0 PST} {-715788000 -25200 1 PDT} {-702486000 -28800 0 PST} {-684338400 -25200 1 PDT} diff --git a/library/tzdata/Asia/Hong_Kong b/library/tzdata/Asia/Hong_Kong index 9420142..8f5ed2c 100644 --- a/library/tzdata/Asia/Hong_Kong +++ b/library/tzdata/Asia/Hong_Kong @@ -4,7 +4,7 @@ set TZData(:Asia/Hong_Kong) { {-9223372036854775808 27402 0 LMT} {-2056690800 28800 0 HKT} {-900910800 32400 1 HKST} - {-891579600 30600 0 HKT} + {-891579600 30600 1 HKWT} {-884248200 32400 0 JST} {-761209200 28800 0 HKT} {-747907200 32400 1 HKST} diff --git a/library/tzdata/Asia/Seoul b/library/tzdata/Asia/Seoul index b226eb5..2df8adc 100644 --- a/library/tzdata/Asia/Seoul +++ b/library/tzdata/Asia/Seoul @@ -5,6 +5,14 @@ set TZData(:Asia/Seoul) { {-1948782472 30600 0 KST} {-1830414600 32400 0 JST} {-767350800 32400 0 KST} + {-681210000 36000 1 KDT} + {-672228000 32400 0 KST} + {-654771600 36000 1 KDT} + {-640864800 32400 0 KST} + {-623408400 36000 1 KDT} + {-609415200 32400 0 KST} + {-588848400 36000 1 KDT} + {-577965600 32400 0 KST} {-498128400 30600 0 KST} {-462702600 34200 1 KDT} {-451733400 30600 0 KST} diff --git a/library/tzdata/Europe/Brussels b/library/tzdata/Europe/Brussels index 3cb9b14..907fff8 100644 --- a/library/tzdata/Europe/Brussels +++ b/library/tzdata/Europe/Brussels @@ -3,7 +3,7 @@ set TZData(:Europe/Brussels) { {-9223372036854775808 1050 0 LMT} {-2840141850 1050 0 BMT} - {-2450953050 0 0 WET} + {-2450995200 0 0 WET} {-1740355200 3600 0 CET} {-1693702800 7200 0 CEST} {-1680483600 3600 0 CET} diff --git a/library/tzdata/Europe/Istanbul b/library/tzdata/Europe/Istanbul index d00533f..a4b9b89 100644 --- a/library/tzdata/Europe/Istanbul +++ b/library/tzdata/Europe/Istanbul @@ -16,13 +16,11 @@ set TZData(:Europe/Istanbul) { {-1428030000 7200 0 EET} {-1409709600 10800 1 EEST} {-1396494000 7200 0 EET} - {-931140000 10800 1 EEST} - {-922762800 7200 0 EET} + {-931053600 10800 1 EEST} + {-922676400 7200 0 EET} {-917834400 10800 1 EEST} {-892436400 7200 0 EET} {-875844000 10800 1 EEST} - {-857358000 7200 0 EET} - {-781063200 10800 1 EEST} {-764737200 7200 0 EET} {-744343200 10800 1 EEST} {-733806000 7200 0 EET} @@ -32,45 +30,32 @@ set TZData(:Europe/Istanbul) { {-670474800 7200 0 EET} {-654141600 10800 1 EEST} {-639025200 7200 0 EET} - {-621828000 10800 1 EEST} + {-622087200 10800 1 EEST} {-606970800 7200 0 EET} {-590032800 10800 1 EEST} - {-575434800 7200 0 EET} + {-575521200 7200 0 EET} {-235620000 10800 1 EEST} - {-228279600 7200 0 EET} + {-194842800 7200 0 EET} {-177732000 10800 1 EEST} {-165726000 7200 0 EET} - {10533600 10800 1 EEST} - {23835600 7200 0 EET} - {41983200 10800 1 EEST} - {55285200 7200 0 EET} - {74037600 10800 1 EEST} - {87339600 7200 0 EET} {107910000 10800 1 EEST} - {121219200 7200 0 EET} + {121215600 7200 0 EET} {133920000 10800 1 EEST} - {152676000 7200 0 EET} - {165362400 10800 1 EEST} - {183502800 7200 0 EET} - {202428000 10800 1 EEST} - {215557200 7200 0 EET} - {228866400 10800 1 EEST} - {245797200 7200 0 EET} - {260316000 10800 1 EEST} - {277246800 14400 0 +04} - {291769200 14400 1 +04} - {308779200 10800 0 +03} - {323827200 14400 1 +04} - {340228800 10800 0 +03} - {354672000 14400 1 +04} - {371678400 10800 0 +03} - {386121600 14400 1 +04} - {403128000 10800 0 +03} - {428446800 14400 1 +04} - {433886400 10800 0 +03} - {482792400 7200 0 EET} - {482796000 10800 1 EEST} - {496702800 7200 0 EET} + {152665200 7200 0 EET} + {164678400 10800 1 EEST} + {184114800 7200 0 EET} + {196214400 10800 1 EEST} + {215564400 7200 0 EET} + {228873600 10800 1 EEST} + {245804400 7200 0 EET} + {260323200 10800 1 EEST} + {267919200 10800 0 +03} + {277254000 10800 0 +03} + {428454000 14400 1 +04} + {433893600 10800 0 +03} + {468111600 7200 0 EET} + {482799600 10800 1 EEST} + {496710000 7200 0 EET} {512521200 10800 1 EEST} {528246000 7200 0 EET} {543970800 10800 1 EEST} diff --git a/library/tzdata/Europe/Kaliningrad b/library/tzdata/Europe/Kaliningrad index e1713ae..2ce7f35 100644 --- a/library/tzdata/Europe/Kaliningrad +++ b/library/tzdata/Europe/Kaliningrad @@ -15,10 +15,11 @@ set TZData(:Europe/Kaliningrad) { {-828226800 3600 0 CET} {-812502000 7200 1 CEST} {-796777200 3600 0 CET} - {-788922000 7200 0 CET} - {-778730400 10800 1 CEST} - {-762663600 7200 0 CET} - {-757389600 10800 0 MSD} + {-781052400 7200 1 CEST} + {-780368400 7200 0 EET} + {-778730400 10800 1 EEST} + {-762663600 7200 0 EET} + {-749095200 10800 0 MSD} {354920400 14400 1 MSD} {370728000 10800 0 MSK} {386456400 14400 1 MSD} diff --git a/library/tzdata/Europe/Vienna b/library/tzdata/Europe/Vienna index 95283eb..3fdad03 100644 --- a/library/tzdata/Europe/Vienna +++ b/library/tzdata/Europe/Vienna @@ -22,7 +22,7 @@ set TZData(:Europe/Vienna) { {-780188400 3600 0 CET} {-757386000 3600 0 CET} {-748479600 7200 1 CEST} - {-733359600 3600 0 CET} + {-733273200 3600 0 CET} {-717634800 7200 1 CEST} {-701910000 3600 0 CET} {-684975600 7200 1 CEST} diff --git a/library/tzdata/Pacific/Fiji b/library/tzdata/Pacific/Fiji index b05985c..e316b93 100644 --- a/library/tzdata/Pacific/Fiji +++ b/library/tzdata/Pacific/Fiji @@ -27,165 +27,165 @@ set TZData(:Pacific/Fiji) { {1515852000 43200 0 +12} {1541253600 46800 1 +12} {1547301600 43200 0 +12} - {1572703200 46800 1 +12} - {1579356000 43200 0 +12} - {1604152800 46800 1 +12} + {1573308000 46800 1 +12} + {1578751200 43200 0 +12} + {1604757600 46800 1 +12} {1610805600 43200 0 +12} - {1636207200 46800 1 +12} + {1636812000 46800 1 +12} {1642255200 43200 0 +12} - {1667656800 46800 1 +12} + {1668261600 46800 1 +12} {1673704800 43200 0 +12} - {1699106400 46800 1 +12} + {1699711200 46800 1 +12} {1705154400 43200 0 +12} - {1730556000 46800 1 +12} - {1737208800 43200 0 +12} - {1762005600 46800 1 +12} + {1731160800 46800 1 +12} + {1736604000 43200 0 +12} + {1762610400 46800 1 +12} {1768658400 43200 0 +12} - {1793455200 46800 1 +12} + {1794060000 46800 1 +12} {1800108000 43200 0 +12} - {1825509600 46800 1 +12} + {1826114400 46800 1 +12} {1831557600 43200 0 +12} - {1856959200 46800 1 +12} + {1857564000 46800 1 +12} {1863007200 43200 0 +12} - {1888408800 46800 1 +12} + {1889013600 46800 1 +12} {1894456800 43200 0 +12} - {1919858400 46800 1 +12} - {1926511200 43200 0 +12} - {1951308000 46800 1 +12} + {1920463200 46800 1 +12} + {1925906400 43200 0 +12} + {1951912800 46800 1 +12} {1957960800 43200 0 +12} - {1983362400 46800 1 +12} + {1983967200 46800 1 +12} {1989410400 43200 0 +12} - {2014812000 46800 1 +12} + {2015416800 46800 1 +12} {2020860000 43200 0 +12} - {2046261600 46800 1 +12} + {2046866400 46800 1 +12} {2052309600 43200 0 +12} - {2077711200 46800 1 +12} + {2078316000 46800 1 +12} {2083759200 43200 0 +12} - {2109160800 46800 1 +12} + {2109765600 46800 1 +12} {2115813600 43200 0 +12} - {2140610400 46800 1 +12} + {2141215200 46800 1 +12} {2147263200 43200 0 +12} - {2172664800 46800 1 +12} + {2173269600 46800 1 +12} {2178712800 43200 0 +12} - {2204114400 46800 1 +12} + {2204719200 46800 1 +12} {2210162400 43200 0 +12} - {2235564000 46800 1 +12} + {2236168800 46800 1 +12} {2241612000 43200 0 +12} - {2267013600 46800 1 +12} - {2273666400 43200 0 +12} - {2298463200 46800 1 +12} + {2267618400 46800 1 +12} + {2273061600 43200 0 +12} + {2299068000 46800 1 +12} {2305116000 43200 0 +12} - {2329912800 46800 1 +12} + {2330517600 46800 1 +12} {2336565600 43200 0 +12} - {2361967200 46800 1 +12} + {2362572000 46800 1 +12} {2368015200 43200 0 +12} - {2393416800 46800 1 +12} + {2394021600 46800 1 +12} {2399464800 43200 0 +12} - {2424866400 46800 1 +12} + {2425471200 46800 1 +12} {2430914400 43200 0 +12} - {2456316000 46800 1 +12} - {2462968800 43200 0 +12} - {2487765600 46800 1 +12} + {2456920800 46800 1 +12} + {2462364000 43200 0 +12} + {2488370400 46800 1 +12} {2494418400 43200 0 +12} - {2519820000 46800 1 +12} + {2520424800 46800 1 +12} {2525868000 43200 0 +12} - {2551269600 46800 1 +12} + {2551874400 46800 1 +12} {2557317600 43200 0 +12} - {2582719200 46800 1 +12} + {2583324000 46800 1 +12} {2588767200 43200 0 +12} - {2614168800 46800 1 +12} - {2620821600 43200 0 +12} - {2645618400 46800 1 +12} + {2614773600 46800 1 +12} + {2620216800 43200 0 +12} + {2646223200 46800 1 +12} {2652271200 43200 0 +12} - {2677068000 46800 1 +12} + {2677672800 46800 1 +12} {2683720800 43200 0 +12} - {2709122400 46800 1 +12} + {2709727200 46800 1 +12} {2715170400 43200 0 +12} - {2740572000 46800 1 +12} + {2741176800 46800 1 +12} {2746620000 43200 0 +12} - {2772021600 46800 1 +12} + {2772626400 46800 1 +12} {2778069600 43200 0 +12} - {2803471200 46800 1 +12} - {2810124000 43200 0 +12} - {2834920800 46800 1 +12} + {2804076000 46800 1 +12} + {2809519200 43200 0 +12} + {2835525600 46800 1 +12} {2841573600 43200 0 +12} - {2866975200 46800 1 +12} + {2867580000 46800 1 +12} {2873023200 43200 0 +12} - {2898424800 46800 1 +12} + {2899029600 46800 1 +12} {2904472800 43200 0 +12} - {2929874400 46800 1 +12} + {2930479200 46800 1 +12} {2935922400 43200 0 +12} - {2961324000 46800 1 +12} + {2961928800 46800 1 +12} {2967372000 43200 0 +12} - {2992773600 46800 1 +12} + {2993378400 46800 1 +12} {2999426400 43200 0 +12} - {3024223200 46800 1 +12} + {3024828000 46800 1 +12} {3030876000 43200 0 +12} - {3056277600 46800 1 +12} + {3056882400 46800 1 +12} {3062325600 43200 0 +12} - {3087727200 46800 1 +12} + {3088332000 46800 1 +12} {3093775200 43200 0 +12} - {3119176800 46800 1 +12} + {3119781600 46800 1 +12} {3125224800 43200 0 +12} - {3150626400 46800 1 +12} - {3157279200 43200 0 +12} - {3182076000 46800 1 +12} + {3151231200 46800 1 +12} + {3156674400 43200 0 +12} + {3182680800 46800 1 +12} {3188728800 43200 0 +12} - {3213525600 46800 1 +12} + {3214130400 46800 1 +12} {3220178400 43200 0 +12} - {3245580000 46800 1 +12} + {3246184800 46800 1 +12} {3251628000 43200 0 +12} - {3277029600 46800 1 +12} + {3277634400 46800 1 +12} {3283077600 43200 0 +12} - {3308479200 46800 1 +12} + {3309084000 46800 1 +12} {3314527200 43200 0 +12} - {3339928800 46800 1 +12} - {3346581600 43200 0 +12} - {3371378400 46800 1 +12} + {3340533600 46800 1 +12} + {3345976800 43200 0 +12} + {3371983200 46800 1 +12} {3378031200 43200 0 +12} - {3403432800 46800 1 +12} + {3404037600 46800 1 +12} {3409480800 43200 0 +12} - {3434882400 46800 1 +12} + {3435487200 46800 1 +12} {3440930400 43200 0 +12} - {3466332000 46800 1 +12} + {3466936800 46800 1 +12} {3472380000 43200 0 +12} - {3497781600 46800 1 +12} - {3504434400 43200 0 +12} - {3529231200 46800 1 +12} + {3498386400 46800 1 +12} + {3503829600 43200 0 +12} + {3529836000 46800 1 +12} {3535884000 43200 0 +12} - {3560680800 46800 1 +12} + {3561285600 46800 1 +12} {3567333600 43200 0 +12} - {3592735200 46800 1 +12} + {3593340000 46800 1 +12} {3598783200 43200 0 +12} - {3624184800 46800 1 +12} + {3624789600 46800 1 +12} {3630232800 43200 0 +12} - {3655634400 46800 1 +12} + {3656239200 46800 1 +12} {3661682400 43200 0 +12} - {3687084000 46800 1 +12} - {3693736800 43200 0 +12} - {3718533600 46800 1 +12} + {3687688800 46800 1 +12} + {3693132000 43200 0 +12} + {3719138400 46800 1 +12} {3725186400 43200 0 +12} - {3750588000 46800 1 +12} + {3751192800 46800 1 +12} {3756636000 43200 0 +12} - {3782037600 46800 1 +12} + {3782642400 46800 1 +12} {3788085600 43200 0 +12} - {3813487200 46800 1 +12} + {3814092000 46800 1 +12} {3819535200 43200 0 +12} - {3844936800 46800 1 +12} + {3845541600 46800 1 +12} {3850984800 43200 0 +12} - {3876386400 46800 1 +12} + {3876991200 46800 1 +12} {3883039200 43200 0 +12} - {3907836000 46800 1 +12} + {3908440800 46800 1 +12} {3914488800 43200 0 +12} - {3939890400 46800 1 +12} + {3940495200 46800 1 +12} {3945938400 43200 0 +12} - {3971340000 46800 1 +12} + {3971944800 46800 1 +12} {3977388000 43200 0 +12} - {4002789600 46800 1 +12} + {4003394400 46800 1 +12} {4008837600 43200 0 +12} - {4034239200 46800 1 +12} - {4040892000 43200 0 +12} - {4065688800 46800 1 +12} + {4034844000 46800 1 +12} + {4040287200 43200 0 +12} + {4066293600 46800 1 +12} {4072341600 43200 0 +12} - {4097138400 46800 1 +12} + {4097743200 46800 1 +12} } diff --git a/library/tzdata/Pacific/Norfolk b/library/tzdata/Pacific/Norfolk index f0556ab..f686df5 100644 --- a/library/tzdata/Pacific/Norfolk +++ b/library/tzdata/Pacific/Norfolk @@ -5,6 +5,168 @@ set TZData(:Pacific/Norfolk) { {-2177493112 40320 0 +1112} {-599656320 41400 0 +1130} {152029800 45000 1 +1230} - {162912600 41400 0 +1130} + {162916200 41400 0 +1130} {1443882600 39600 0 +11} + {1561899600 39600 0 +12} + {1570287600 43200 1 +12} + {1586012400 39600 0 +12} + {1601737200 43200 1 +12} + {1617462000 39600 0 +12} + {1633186800 43200 1 +12} + {1648911600 39600 0 +12} + {1664636400 43200 1 +12} + {1680361200 39600 0 +12} + {1696086000 43200 1 +12} + {1712415600 39600 0 +12} + {1728140400 43200 1 +12} + {1743865200 39600 0 +12} + {1759590000 43200 1 +12} + {1775314800 39600 0 +12} + {1791039600 43200 1 +12} + {1806764400 39600 0 +12} + {1822489200 43200 1 +12} + {1838214000 39600 0 +12} + {1853938800 43200 1 +12} + {1869663600 39600 0 +12} + {1885993200 43200 1 +12} + {1901718000 39600 0 +12} + {1917442800 43200 1 +12} + {1933167600 39600 0 +12} + {1948892400 43200 1 +12} + {1964617200 39600 0 +12} + {1980342000 43200 1 +12} + {1996066800 39600 0 +12} + {2011791600 43200 1 +12} + {2027516400 39600 0 +12} + {2043241200 43200 1 +12} + {2058966000 39600 0 +12} + {2075295600 43200 1 +12} + {2091020400 39600 0 +12} + {2106745200 43200 1 +12} + {2122470000 39600 0 +12} + {2138194800 43200 1 +12} + {2153919600 39600 0 +12} + {2169644400 43200 1 +12} + {2185369200 39600 0 +12} + {2201094000 43200 1 +12} + {2216818800 39600 0 +12} + {2233148400 43200 1 +12} + {2248873200 39600 0 +12} + {2264598000 43200 1 +12} + {2280322800 39600 0 +12} + {2296047600 43200 1 +12} + {2311772400 39600 0 +12} + {2327497200 43200 1 +12} + {2343222000 39600 0 +12} + {2358946800 43200 1 +12} + {2374671600 39600 0 +12} + {2390396400 43200 1 +12} + {2406121200 39600 0 +12} + {2422450800 43200 1 +12} + {2438175600 39600 0 +12} + {2453900400 43200 1 +12} + {2469625200 39600 0 +12} + {2485350000 43200 1 +12} + {2501074800 39600 0 +12} + {2516799600 43200 1 +12} + {2532524400 39600 0 +12} + {2548249200 43200 1 +12} + {2563974000 39600 0 +12} + {2579698800 43200 1 +12} + {2596028400 39600 0 +12} + {2611753200 43200 1 +12} + {2627478000 39600 0 +12} + {2643202800 43200 1 +12} + {2658927600 39600 0 +12} + {2674652400 43200 1 +12} + {2690377200 39600 0 +12} + {2706102000 43200 1 +12} + {2721826800 39600 0 +12} + {2737551600 43200 1 +12} + {2753276400 39600 0 +12} + {2769606000 43200 1 +12} + {2785330800 39600 0 +12} + {2801055600 43200 1 +12} + {2816780400 39600 0 +12} + {2832505200 43200 1 +12} + {2848230000 39600 0 +12} + {2863954800 43200 1 +12} + {2879679600 39600 0 +12} + {2895404400 43200 1 +12} + {2911129200 39600 0 +12} + {2926854000 43200 1 +12} + {2942578800 39600 0 +12} + {2958908400 43200 1 +12} + {2974633200 39600 0 +12} + {2990358000 43200 1 +12} + {3006082800 39600 0 +12} + {3021807600 43200 1 +12} + {3037532400 39600 0 +12} + {3053257200 43200 1 +12} + {3068982000 39600 0 +12} + {3084706800 43200 1 +12} + {3100431600 39600 0 +12} + {3116761200 43200 1 +12} + {3132486000 39600 0 +12} + {3148210800 43200 1 +12} + {3163935600 39600 0 +12} + {3179660400 43200 1 +12} + {3195385200 39600 0 +12} + {3211110000 43200 1 +12} + {3226834800 39600 0 +12} + {3242559600 43200 1 +12} + {3258284400 39600 0 +12} + {3274009200 43200 1 +12} + {3289734000 39600 0 +12} + {3306063600 43200 1 +12} + {3321788400 39600 0 +12} + {3337513200 43200 1 +12} + {3353238000 39600 0 +12} + {3368962800 43200 1 +12} + {3384687600 39600 0 +12} + {3400412400 43200 1 +12} + {3416137200 39600 0 +12} + {3431862000 43200 1 +12} + {3447586800 39600 0 +12} + {3463311600 43200 1 +12} + {3479641200 39600 0 +12} + {3495366000 43200 1 +12} + {3511090800 39600 0 +12} + {3526815600 43200 1 +12} + {3542540400 39600 0 +12} + {3558265200 43200 1 +12} + {3573990000 39600 0 +12} + {3589714800 43200 1 +12} + {3605439600 39600 0 +12} + {3621164400 43200 1 +12} + {3636889200 39600 0 +12} + {3653218800 43200 1 +12} + {3668943600 39600 0 +12} + {3684668400 43200 1 +12} + {3700393200 39600 0 +12} + {3716118000 43200 1 +12} + {3731842800 39600 0 +12} + {3747567600 43200 1 +12} + {3763292400 39600 0 +12} + {3779017200 43200 1 +12} + {3794742000 39600 0 +12} + {3810466800 43200 1 +12} + {3826191600 39600 0 +12} + {3842521200 43200 1 +12} + {3858246000 39600 0 +12} + {3873970800 43200 1 +12} + {3889695600 39600 0 +12} + {3905420400 43200 1 +12} + {3921145200 39600 0 +12} + {3936870000 43200 1 +12} + {3952594800 39600 0 +12} + {3968319600 43200 1 +12} + {3984044400 39600 0 +12} + {4000374000 43200 1 +12} + {4016098800 39600 0 +12} + {4031823600 43200 1 +12} + {4047548400 39600 0 +12} + {4063273200 43200 1 +12} + {4078998000 39600 0 +12} + {4094722800 43200 1 +12} } -- cgit v0.12 From 55d9c007c016354d407058958220cafc2a015a67 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 25 Sep 2019 12:17:29 +0000 Subject: Use consistantly "/D" in stead of "-D" for Microsoft compilers (MSVC) --- win/rules.vc | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/win/rules.vc b/win/rules.vc index 812e607..a4c94ff 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -455,45 +455,45 @@ This compiler does not support profile guided optimization. # Set our defines now armed with our options. #---------------------------------------------------------- -OPTDEFINES = -DTCL_CFGVAL_ENCODING=$(CFG_ENCODING) -DSTDC_HEADERS +OPTDEFINES = /DTCL_CFGVAL_ENCODING=$(CFG_ENCODING) /DSTDC_HEADERS !if $(TCL_MEM_DEBUG) -OPTDEFINES = $(OPTDEFINES) -DTCL_MEM_DEBUG +OPTDEFINES = $(OPTDEFINES) /DTCL_MEM_DEBUG !endif !if $(TCL_COMPILE_DEBUG) -OPTDEFINES = $(OPTDEFINES) -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS +OPTDEFINES = $(OPTDEFINES) /DTCL_COMPILE_DEBUG /DTCL_COMPILE_STATS !endif !if $(TCL_THREADS) -OPTDEFINES = $(OPTDEFINES) -DTCL_THREADS=1 +OPTDEFINES = $(OPTDEFINES) /DTCL_THREADS=1 !if $(USE_THREAD_ALLOC) -OPTDEFINES = $(OPTDEFINES) -DUSE_THREAD_ALLOC=1 +OPTDEFINES = $(OPTDEFINES) /DUSE_THREAD_ALLOC=1 !endif !endif !if $(STATIC_BUILD) -OPTDEFINES = $(OPTDEFINES) -DSTATIC_BUILD +OPTDEFINES = $(OPTDEFINES) /DSTATIC_BUILD !endif !if $(TCL_NO_DEPRECATED) -OPTDEFINES = $(OPTDEFINES) -DTCL_NO_DEPRECATED +OPTDEFINES = $(OPTDEFINES) /DTCL_NO_DEPRECATED !endif !if !$(DEBUG) -OPTDEFINES = $(OPTDEFINES) -DNDEBUG +OPTDEFINES = $(OPTDEFINES) /DNDEBUG !if $(OPTIMIZING) -OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_OPTIMIZED +OPTDEFINES = $(OPTDEFINES) /DTCL_CFG_OPTIMIZED !endif !endif !if $(PROFILE) -OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_PROFILED +OPTDEFINES = $(OPTDEFINES) /DTCL_CFG_PROFILED !endif !if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64" -OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_DO64BIT +OPTDEFINES = $(OPTDEFINES) /DTCL_CFG_DO64BIT !endif !if $(VCVERSION) < 1300 -OPTDEFINES = $(OPTDEFINES) -DNO_STRTOI64 +OPTDEFINES = $(OPTDEFINES) /DNO_STRTOI64 !endif !if "$(_USE_64BIT_TIME_T)" == "1" -OPTDEFINES = $(OPTDEFINES) -D_USE_64BIT_TIME_T +OPTDEFINES = $(OPTDEFINES) /D_USE_64BIT_TIME_T !endif #---------------------------------------------------------- -- cgit v0.12 From 988da40f48834cf7bc1eb8e97d93e0eed475f9ac Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 25 Sep 2019 12:18:14 +0000 Subject: Fix failing test-case iocmd-21.20 on Travis --- tests/ioCmd.test | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/tests/ioCmd.test b/tests/ioCmd.test index c3893bc..2e31a21 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -22,7 +22,6 @@ if {[lsearch [namespace children] ::tcltest] == -1} { testConstraint fcopy [llength [info commands fcopy]] testConstraint testchannel [llength [info commands testchannel]] testConstraint testthread [llength [info commands testthread]] -testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] #---------------------------------------------------------------------- @@ -755,7 +754,7 @@ test iocmd-21.19 {chan create, init failure -> no channel, no finalize} -match g rename foo {} set res } -result {{} {initialize rc* {read write}} 1 {*all required methods*} {}} -test iocmd-21.20 {Bug 88aef05cda} -constraints knownMsvcBug -setup { +test iocmd-21.20 {Bug 88aef05cda} -setup { proc foo {method chan args} { switch -- $method blocking { chan configure $chan -blocking [lindex $args 0] @@ -769,11 +768,11 @@ test iocmd-21.20 {Bug 88aef05cda} -constraints knownMsvcBug -setup { } set ch [chan create {read write} foo] } -body { - list [catch {chan configure $ch -blocking 0} m] $m + chan configure $ch -blocking 0 } -cleanup { close $ch rename foo {} -} -match glob -result {1 {*nested eval*}} +} -match glob -returnCodes 1 -result {*(infinite loop?)*} test iocmd-21.21 {[close] in [read] segfaults} -setup { proc foo {method chan args} { switch -- $method initialize { -- cgit v0.12