diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2017-12-21 13:26:56 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2017-12-21 13:26:56 (GMT) |
commit | 53795bd1990e95c19850746d2117171a40d7ceef (patch) | |
tree | f3f600f0c8409baeb7baa898d4c21e00e43698ff | |
parent | 5c4f8d88b5491e7656dedeab904b42b437b83e01 (diff) | |
parent | 5a190dd003f0caaee265f6664bd1bbee842a2d66 (diff) | |
download | tcl-53795bd1990e95c19850746d2117171a40d7ceef.zip tcl-53795bd1990e95c19850746d2117171a40d7ceef.tar.gz tcl-53795bd1990e95c19850746d2117171a40d7ceef.tar.bz2 |
merge core-8-branch
-rw-r--r-- | .fossil-settings/ignore-glob | 1 | ||||
-rw-r--r-- | generic/tclBasic.c | 6 | ||||
-rw-r--r-- | generic/tclCompile.h | 4 | ||||
-rw-r--r-- | generic/tclDisassemble.c | 4 | ||||
-rw-r--r-- | generic/tclEncoding.c | 2 | ||||
-rw-r--r-- | generic/tclEnsemble.c | 2 | ||||
-rw-r--r-- | generic/tclExecute.c | 6 | ||||
-rw-r--r-- | generic/tclInt.decls | 2 | ||||
-rw-r--r-- | generic/tclInt.h | 39 | ||||
-rw-r--r-- | generic/tclIntDecls.h | 5 | ||||
-rw-r--r-- | generic/tclNamesp.c | 21 | ||||
-rw-r--r-- | generic/tclObj.c | 6 | ||||
-rw-r--r-- | generic/tclProc.c | 2 | ||||
-rw-r--r-- | generic/tclStubInit.c | 1 | ||||
-rw-r--r-- | generic/tclUtil.c | 10 | ||||
-rw-r--r-- | library/init.tcl | 8 | ||||
-rw-r--r-- | tests/basic.test | 10 | ||||
-rw-r--r-- | tests/namespace.test | 13 | ||||
-rw-r--r-- | unix/Makefile.in | 4 | ||||
-rw-r--r-- | unix/tclUnixInit.c | 12 | ||||
-rw-r--r-- | unix/tclUnixSock.c | 2 | ||||
-rw-r--r-- | win/coffbase.txt | 43 | ||||
-rw-r--r-- | win/rules.vc | 38 | ||||
-rw-r--r-- | win/tclWinInit.c | 6 | ||||
-rw-r--r-- | win/tclWinSock.c | 2 |
25 files changed, 103 insertions, 146 deletions
diff --git a/.fossil-settings/ignore-glob b/.fossil-settings/ignore-glob index c85b488..08e405d 100644 --- a/.fossil-settings/ignore-glob +++ b/.fossil-settings/ignore-glob @@ -44,5 +44,6 @@ unix/pkgs/* win/Debug* win/Release* win/pkgs/* +win/coffbase.txt win/tcl.hpj win/nmhlp-out.txt diff --git a/generic/tclBasic.c b/generic/tclBasic.c index eceea31..3ed3447 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -954,9 +954,11 @@ Tcl_CreateInterp(void) Tcl_SetVar2(interp, "tcl_patchLevel", NULL, TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "tcl_version", NULL, TCL_VERSION, TCL_GLOBAL_ONLY); +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 Tcl_TraceVar2(interp, "tcl_precision", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, TclPrecTraceProc, NULL); +#endif /* !TCL_NO_DEPRECATED */ TclpSetVariables(interp); #ifdef TCL_THREADS @@ -4606,7 +4608,7 @@ TEOV_Exception( if (result == TCL_RETURN) { result = TclUpdateReturnInfo(iPtr); } - if ((result != TCL_ERROR) && !allowExceptions) { + if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) { ProcessUnexpectedResult(interp, result); result = TCL_ERROR; } @@ -4787,7 +4789,7 @@ TEOV_RunEnterTraces( { Interp *iPtr = (Interp *) interp; Command *cmdPtr = *cmdPtrPtr; - size_t newEpoch, cmdEpoch = cmdPtr->cmdEpoch; + unsigned int newEpoch, cmdEpoch = cmdPtr->cmdEpoch; int length, traceCode = TCL_OK; const char *command = TclGetStringFromObj(commandPtr, &length); diff --git a/generic/tclCompile.h b/generic/tclCompile.h index bd7aaab..f20ecfd 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -425,11 +425,11 @@ typedef struct ByteCode { * compiled. If the code is executed if a * different namespace, it must be * recompiled. */ - size_t nsEpoch; /* Value of nsPtr->resolverEpoch when this + unsigned int nsEpoch; /* Value of nsPtr->resolverEpoch when this * ByteCode was compiled. Used to invalidate * code when new namespace resolution rules * are put into effect. */ - int refCount; /* Reference count: set 1 when created plus 1 + unsigned int refCount; /* Reference count: set 1 when created plus 1 * for each execution of the code currently * active. This structure can be freed when * refCount becomes zero. */ diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c index d61ed42..e07080a 100644 --- a/generic/tclDisassemble.c +++ b/generic/tclDisassemble.c @@ -254,7 +254,7 @@ DisassembleByteCodeObj( Tcl_Obj *bufferObj, *fileObj; TclNewObj(bufferObj); - if (codePtr->refCount <= 0) { + if (!codePtr->refCount) { return bufferObj; /* Already freed. */ } @@ -312,7 +312,7 @@ DisassembleByteCodeObj( int numCompiledLocals = procPtr->numCompiledLocals; Tcl_AppendPrintfToObj(bufferObj, - " Proc %p, refCt %d, args %d, compiled locals %d\n", + " Proc %p, refCt %u, args %d, compiled locals %d\n", procPtr, procPtr->refCount, procPtr->numArgs, numCompiledLocals); if (numCompiledLocals > 0) { diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index e1e26d3..46db12c 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -3609,7 +3609,7 @@ unilen( static void InitializeEncodingSearchPath( char **valuePtr, - size_t *lengthPtr, + unsigned int *lengthPtr, Tcl_Encoding *encodingPtr) { const char *bytes; diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 580ea5c..e7bfbac 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -92,7 +92,7 @@ static const Tcl_ObjType ensembleCmdType = { */ typedef struct { - size_t epoch; /* Used to confirm when the data in this + unsigned int epoch; /* Used to confirm when the data in this * really structure matches up with the * ensemble. */ Command *token; /* Reference to the command for which this diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 95664d0..f2cda0c 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -9476,9 +9476,9 @@ PrintByteCodeInfo( Proc *procPtr = codePtr->procPtr; Interp *iPtr = (Interp *) *codePtr->interpHandle; - fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_LL_MODIFIER "u, epoch %" TCL_LL_MODIFIER "u, interp 0x%p (epoch %" TCL_LL_MODIFIER "u)\n", - codePtr, (Tcl_WideInt)codePtr->refCount, (Tcl_WideInt)codePtr->compileEpoch, iPtr, - (Tcl_WideInt)iPtr->compileEpoch); + fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_LL_MODIFIER "u, epoch %u, interp 0x%p (epoch %u)\n", + codePtr, (Tcl_WideInt)codePtr->refCount, codePtr->compileEpoch, iPtr, + iPtr->compileEpoch); fprintf(stdout, " Source: "); TclPrintSource(stdout, codePtr->source, 60); diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 33bf0b3..175ea9c 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -355,7 +355,7 @@ declare 81 { # declare 87 { # void TclPlatformInit(Tcl_Interp *interp) # } -declare 88 { +declare 88 {deprecated {}} { char *TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags) } diff --git a/generic/tclInt.h b/generic/tclInt.h index 1fd252f..880899f 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -265,7 +265,7 @@ typedef struct Namespace { * strings; values have type (Namespace *). If * NULL, there are no children. */ #endif - size_t nsId; /* Unique id for the namespace. */ + unsigned long nsId; /* Unique id for the namespace. */ Tcl_Interp *interp; /* The interpreter containing this * namespace. */ int flags; /* OR-ed combination of the namespace status @@ -274,7 +274,7 @@ typedef struct Namespace { * frames for this namespace that are on the * Tcl call stack. The namespace won't be * freed until activationCount becomes zero. */ - int refCount; /* Count of references by namespaceName + unsigned int refCount; /* Count of references by namespaceName * objects. The namespace can't be freed until * refCount becomes zero. */ Tcl_HashTable cmdTable; /* Contains all the commands currently @@ -299,12 +299,12 @@ typedef struct Namespace { * registered using "namespace export". */ int maxExportPatterns; /* Mumber of export patterns for which space * is currently allocated. */ - size_t cmdRefEpoch; /* Incremented if a newly added command + unsigned int cmdRefEpoch; /* Incremented if a newly added command * shadows a command for which this namespace * has already cached a Command* pointer; this * causes all its cached Command* pointers to * be invalidated. */ - size_t resolverEpoch; /* Incremented whenever (a) the name + unsigned int resolverEpoch; /* Incremented whenever (a) the name * resolution rules change for this namespace * or (b) a newly added command shadows a * command that is compiled to bytecodes. This @@ -331,7 +331,7 @@ typedef struct Namespace { * LookupCompiledLocal to resolve variable * references within the namespace at compile * time. */ - size_t exportLookupEpoch; /* Incremented whenever a command is added to + unsigned int exportLookupEpoch; /* Incremented whenever a command is added to * a namespace, removed from a namespace or * the exports of a namespace are changed. * Allows TIP#112-driven command lists to be @@ -432,7 +432,7 @@ typedef struct EnsembleConfig { * if the command has been deleted (or never * existed; the global namespace never has an * ensemble command.) */ - size_t epoch; /* The epoch at which this ensemble's table of + unsigned int epoch; /* The epoch at which this ensemble's table of * exported commands is valid. */ char **subcommandArrayPtr; /* Array of ensemble subcommand names. At all * consistent points, this will have the same @@ -545,7 +545,7 @@ typedef struct CommandTrace { struct CommandTrace *nextPtr; /* Next in list of traces associated with a * particular command. */ - int refCount; /* Used to ensure this structure is not + unsigned int refCount; /* Used to ensure this structure is not * deleted too early. Keeps track of how many * pieces of code have a pointer to this * structure. */ @@ -618,7 +618,7 @@ typedef struct Var { typedef struct VarInHash { Var var; - int refCount; /* Counts number of active uses of this + unsigned int refCount; /* Counts number of active uses of this * variable: 1 for the entry in the hash * table, 1 for each additional variable whose * linkPtr points here, 1 for each nested @@ -950,7 +950,7 @@ typedef struct CompiledLocal { typedef struct Proc { struct Interp *iPtr; /* Interpreter for which this command is * defined. */ - int refCount; /* Reference count: 1 if still present in + unsigned int refCount; /* Reference count: 1 if still present in * command table plus 1 for each call to the * procedure that is currently active. This * structure can be freed when refCount @@ -1067,7 +1067,7 @@ typedef struct AssocData { */ typedef struct LocalCache { - int refCount; + unsigned int refCount; int numVars; Tcl_Obj *varName0; } LocalCache; @@ -1229,7 +1229,7 @@ typedef struct CmdFrame { typedef struct CFWord { CmdFrame *framePtr; /* CmdFrame to access. */ int word; /* Index of the word in the command. */ - int refCount; /* Number of times the word is on the + unsigned int refCount; /* Number of times the word is on the * stack. */ } CFWord; @@ -1634,12 +1634,12 @@ typedef struct Command { * recreated). */ Namespace *nsPtr; /* Points to the namespace containing this * command. */ - int refCount; /* 1 if in command hashtable plus 1 for each + unsigned int refCount; /* 1 if in command hashtable plus 1 for each * reference from a CmdName Tcl object * representing a command's name in a ByteCode * instruction sequence. This structure can be * freed when refCount becomes zero. */ - size_t cmdEpoch; /* Incremented to invalidate any references + unsigned int cmdEpoch; /* Incremented to invalidate any references * that point to this command when it is * renamed, deleted, hidden, or exposed. */ CompileProc *compileProc; /* Procedure called to compile command. NULL @@ -2384,7 +2384,7 @@ typedef enum TclEolTranslation { */ typedef struct List { - int refCount; + unsigned int refCount; int maxElemCount; /* Total number of element array slots. */ int elemCount; /* Current number of list elements. */ int canonicalFlag; /* Set if the string representation was @@ -2626,7 +2626,7 @@ typedef Tcl_ObjCmdProc *TclObjCmdProcType; *---------------------------------------------------------------- */ -typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, size_t *lengthPtr, +typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, unsigned int *lengthPtr, Tcl_Encoding *encodingPtr); /* @@ -2638,9 +2638,9 @@ typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, size_t *lengthPtr, */ typedef struct ProcessGlobalValue { - size_t epoch; /* Epoch counter to detect changes in the + unsigned int epoch; /* Epoch counter to detect changes in the * master value. */ - size_t numBytes; /* Length of the master string. */ + unsigned int numBytes; /* Length of the master string. */ char *value; /* The master string value. */ Tcl_Encoding encoding; /* system encoding when master string was * initialized. */ @@ -2960,8 +2960,7 @@ MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr, MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr); MODULE_SCOPE Tcl_Obj *const * TclFetchEnsembleRoot(Tcl_Interp *interp, Tcl_Obj *const *objv, int objc, int *objcPtr); -Tcl_Namespace * TclEnsureNamespace( - Tcl_Interp *interp, +MODULE_SCOPE Tcl_Namespace * TclEnsureNamespace(Tcl_Interp *interp, Tcl_Namespace *namespacePtr); MODULE_SCOPE void TclFinalizeAllocSubsystem(void); @@ -3125,7 +3124,7 @@ MODULE_SCOPE int TclpThreadCreate(Tcl_ThreadId *idPtr, int stackSize, int flags); MODULE_SCOPE int TclpFindVariable(const char *name, int *lengthPtr); MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr, - size_t *lengthPtr, Tcl_Encoding *encodingPtr); + unsigned int *lengthPtr, Tcl_Encoding *encodingPtr); MODULE_SCOPE void TclpInitLock(void); MODULE_SCOPE void TclpInitPlatform(void); MODULE_SCOPE void TclpInitUnlock(void); diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 5848bb3..bc8f7b8 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -233,7 +233,8 @@ EXTERN char * TclpRealloc(char *ptr, unsigned int size); /* Slot 86 is reserved */ /* Slot 87 is reserved */ /* 88 */ -EXTERN char * TclPrecTraceProc(ClientData clientData, +TCL_DEPRECATED("") +char * TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); /* 89 */ @@ -743,7 +744,7 @@ typedef struct TclIntStubs { void (*reserved85)(void); void (*reserved86)(void); void (*reserved87)(void); - char * (*tclPrecTraceProc) (ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); /* 88 */ + TCL_DEPRECATED_API("") char * (*tclPrecTraceProc) (ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); /* 88 */ int (*tclPreventAliasLoop) (Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd); /* 89 */ void (*reserved90)(void); void (*tclProcCleanupProc) (Proc *procPtr); /* 91 */ diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index d661856..f82d23d 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -32,7 +32,7 @@ */ typedef struct { - size_t numNsCreated; /* Count of the number of namespaces created + unsigned long numNsCreated; /* Count of the number of namespaces created * within the thread. This value is used as a * unique id for each namespace. Cannot be * per-interp because the nsId is used to @@ -402,7 +402,7 @@ Tcl_PopCallFrame( } if (framePtr->numCompiledLocals > 0) { TclDeleteCompiledLocalVars(iPtr, framePtr); - if (--framePtr->localCachePtr->refCount == 0) { + if (framePtr->localCachePtr->refCount-- <= 1) { TclFreeLocalCache(interp, framePtr->localCachePtr); } framePtr->localCachePtr = NULL; @@ -916,6 +916,11 @@ Tcl_DeleteNamespace( Command *cmdPtr; /* + * Ensure that this namespace doesn't get deallocated in the meantime. + */ + nsPtr->refCount++; + + /* * Give anyone interested - notably TclOO - a chance to use this namespace * normally despite the fact that the namespace is going to go. Allows the * calling of destructors. Will only be called once (unless re-established @@ -1047,16 +1052,7 @@ Tcl_DeleteNamespace( #endif Tcl_DeleteHashTable(&nsPtr->cmdTable); - /* - * If the reference count is 0, then discard the namespace. - * Otherwise, mark it as "dead" so that it can't be used. - */ - - if (nsPtr->refCount == 0) { - NamespaceFree(nsPtr); - } else { - nsPtr->flags |= NS_DEAD; - } + nsPtr ->flags |= NS_DEAD; } else { /* * Restore the ::errorInfo and ::errorCode traces. @@ -1073,6 +1069,7 @@ Tcl_DeleteNamespace( nsPtr->flags &= ~(NS_DYING|NS_KILLED); } } + TclNsDecrRefCount(nsPtr); } /* diff --git a/generic/tclObj.c b/generic/tclObj.c index 1a00011..4ec0a57 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -344,17 +344,17 @@ typedef struct ResolvedCmdName { * reference (not the namespace that contains * the referenced command). NULL if the name * is fully qualified.*/ - size_t refNsId; /* refNsPtr's unique namespace id. Used to + unsigned long refNsId; /* refNsPtr's unique namespace id. Used to * verify that refNsPtr is still valid (e.g., * it's possible that the cmd's containing * namespace was deleted and a new one created * at the same address). */ - size_t refNsCmdEpoch; /* Value of the referencing namespace's + unsigned int refNsCmdEpoch; /* Value of the referencing namespace's * cmdRefEpoch when the pointer was cached. * Before using the cached pointer, we check * if the namespace's epoch was incremented; * if so, this cached pointer is invalid. */ - size_t cmdEpoch; /* Value of the command's cmdEpoch when this + unsigned int cmdEpoch; /* Value of the command's cmdEpoch when this * pointer was cached. Before using the cached * pointer, we check if the cmd's epoch was * incremented; if so, the cmd was renamed, diff --git a/generic/tclProc.c b/generic/tclProc.c index b89357c..70dc4dc 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -2380,7 +2380,7 @@ FreeLambdaInternalRep( Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1; Tcl_Obj *nsObjPtr = objPtr->internalRep.twoPtrValue.ptr2; - if (procPtr->refCount-- == 1) { + if (procPtr->refCount-- <= 1) { TclProcCleanupProc(procPtr); } TclDecrRefCount(nsObjPtr); diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 6c20340..bd0971b 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -64,6 +64,7 @@ static int TclSockMinimumBuffersOld(int sock, int size) # define TclGetStartupScriptPath 0 # define TclSetStartupScriptFileName 0 # define TclGetStartupScriptFileName 0 +# define TclPrecTraceProc 0 # define TclpInetNtoa 0 # define TclWinGetServByName 0 # define TclWinGetSockOpt 0 diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 51af016..15018de 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3298,6 +3298,7 @@ Tcl_PrintDouble( *---------------------------------------------------------------------- */ +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 /* ARGSUSED */ char * TclPrecTraceProc( @@ -3355,6 +3356,7 @@ TclPrecTraceProc( *precisionPtr = prec; return NULL; } +#endif /* !TCL_NO_DEPRECATED)*/ /* *---------------------------------------------------------------------- @@ -4010,7 +4012,7 @@ TclSetProcessGlobalValue( Tcl_IncrRefCount(newValue); cacheMap = GetThreadHash(&pgvPtr->key); ClearHash(cacheMap); - hPtr = Tcl_CreateHashEntry(cacheMap, (void *)(pgvPtr->epoch), &dummy); + hPtr = Tcl_CreateHashEntry(cacheMap, (void *)(size_t)(pgvPtr->epoch), &dummy); Tcl_SetHashValue(hPtr, newValue); Tcl_MutexUnlock(&pgvPtr->mutex); } @@ -4036,7 +4038,7 @@ TclGetProcessGlobalValue( Tcl_Obj *value = NULL; Tcl_HashTable *cacheMap; Tcl_HashEntry *hPtr; - size_t epoch = pgvPtr->epoch; + unsigned int epoch = pgvPtr->epoch; if (pgvPtr->encoding) { Tcl_Encoding current = Tcl_GetEncoding(NULL, NULL); @@ -4070,7 +4072,7 @@ TclGetProcessGlobalValue( } } cacheMap = GetThreadHash(&pgvPtr->key); - hPtr = Tcl_FindHashEntry(cacheMap, (void *) (epoch)); + hPtr = Tcl_FindHashEntry(cacheMap, (void *)(size_t)epoch); if (NULL == hPtr) { int dummy; @@ -4103,7 +4105,7 @@ TclGetProcessGlobalValue( value = Tcl_NewStringObj(pgvPtr->value, pgvPtr->numBytes); hPtr = Tcl_CreateHashEntry(cacheMap, - (void *)(pgvPtr->epoch), &dummy); + (void *)(size_t)(pgvPtr->epoch), &dummy); Tcl_MutexUnlock(&pgvPtr->mutex); Tcl_SetHashValue(hPtr, value); Tcl_IncrRefCount(value); diff --git a/library/init.tcl b/library/init.tcl index 4424087..530ce58 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -619,8 +619,7 @@ proc auto_execok name { set auto_execs($name) "" set shellBuiltins [list assoc cls copy date del dir echo erase ftype \ - md mkdir mklink move rd ren rename rmdir start \ - time type ver vol] + md mkdir mklink move rd ren rename rmdir start time type ver vol] if {[info exists env(PATHEXT)]} { # Add an initial ; to have the {} extension check first. set execExtensions [split ";$env(PATHEXT)" ";"] @@ -654,10 +653,7 @@ proc auto_execok name { set windir $env(WINDIR) } if {[info exists windir]} { - if {$tcl_platform(os) eq "Windows NT"} { - append path "$windir/system32;" - } - append path "$windir/system;$windir;" + append path "$windir/system32;$windir/system;$windir;" } foreach var {PATH Path path} { diff --git a/tests/basic.test b/tests/basic.test index 7819241..d47613a 100644 --- a/tests/basic.test +++ b/tests/basic.test @@ -984,6 +984,16 @@ test basic-49.2 {Tcl_EvalEx: verify TCL_EVAL_GLOBAL operation} testevalex { set ::context } {global} +test basic-50.1 {[586e71dce4] EvalObjv level #0 exception handling} -setup { + interp create slave + interp alias {} foo slave return +} -body { + list [catch foo m] $m +} -cleanup { + unset -nocomplain m + interp delete slave +} -result {0 {}} + # Clean up after expand tests unset noComp l1 l2 constraints rename l3 {} diff --git a/tests/namespace.test b/tests/namespace.test index 9fa9331..b9e6ead 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -196,6 +196,19 @@ test namespace-7.7 {Bug 1655305} -setup { interp delete slave } -result {} +test namespace-7.8 {Bug ba1419303b4c} -setup { + namespace eval ns1 { + namespace ensemble create + } + + trace add command ns1 delete { + namespace delete ns1 + } +} -body { + # No segmentation fault given --enable-symbols=mem. + namespace delete ns1 +} -result {} + test namespace-8.1 {TclTeardownNamespace, delete global namespace} { catch {interp delete test_interp} interp create test_interp diff --git a/unix/Makefile.in b/unix/Makefile.in index 032b5ac..f3b9782 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -2050,9 +2050,7 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M cp -p $(TOP_DIR)/win/*.[ch] $(TOP_DIR)/win/*.ico $(TOP_DIR)/win/*.rc \ $(DISTDIR)/win cp -p $(TOP_DIR)/win/*.bat $(DISTDIR)/win - cp -p $(TOP_DIR)/win/makefile.* $(DISTDIR)/win - cp -p $(TOP_DIR)/win/rules.vc $(DISTDIR)/win - cp -p $(TOP_DIR)/win/coffbase.txt $(DISTDIR)/win + cp -p $(TOP_DIR)/win/*.vc $(DISTDIR)/win cp -p $(TOP_DIR)/win/tcl.hpj.in $(DISTDIR)/win cp -p $(TOP_DIR)/win/tcl.ds* $(DISTDIR)/win cp -p $(TOP_DIR)/win/README $(DISTDIR)/win diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index feeffa6..cc66569 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -39,11 +39,6 @@ DLLIMPORT extern __stdcall void FreeLibrary(void *); DLLIMPORT extern __stdcall void *GetProcAddress(void *, const char *); DLLIMPORT extern __stdcall void GetSystemInfo(void *); -#define NUMPLATFORMS 4 -static const char *const platforms[NUMPLATFORMS] = { - "Win32s", "Windows 95", "Windows NT", "Windows CE" -}; - #define NUMPROCESSORS 11 static const char *const processors[NUMPROCESSORS] = { "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil", @@ -453,7 +448,7 @@ TclpInitPlatform(void) void TclpInitLibraryPath( char **valuePtr, - size_t *lengthPtr, + unsigned int *lengthPtr, Tcl_Encoding *encodingPtr) { #define LIBRARY_SIZE 32 @@ -890,10 +885,7 @@ TclpSetVariables( GetSystemInfo(&sysInfo); - if (osInfo.dwPlatformId < NUMPLATFORMS) { - Tcl_SetVar2(interp, "tcl_platform", "os", - platforms[osInfo.dwPlatformId], TCL_GLOBAL_ONLY); - } + Tcl_SetVar2(interp, "tcl_platform", "os", "Windows NT", TCL_GLOBAL_ONLY); sprintf(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion); Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY); if (sysInfo.wProcessorArchitecture < NUMPROCESSORS) { diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c index 45abc01..980ab4d 100644 --- a/unix/tclUnixSock.c +++ b/unix/tclUnixSock.c @@ -217,7 +217,7 @@ printaddrinfo( static void InitializeHostName( char **valuePtr, - size_t *lengthPtr, + unsigned int *lengthPtr, Tcl_Encoding *encodingPtr) { const char *native = NULL; diff --git a/win/coffbase.txt b/win/coffbase.txt deleted file mode 100644 index 3314f26..0000000 --- a/win/coffbase.txt +++ /dev/null @@ -1,43 +0,0 @@ -;
-; This file defines the virtual base addresses for the Dynamic Link Libraries
-; that are part of the Tcl system. The first token on a line is the key (or name
-; of the DLL) and the second token is the virtual base address, in hexidecimal.
-; The third token is the maximum size of the DLL image file, including symbols.
-;
-; Using a specified "prefered load address" should speed loading time by avoiding
-; relocations (NT supported only). It is assumed extension authors will contribute
-; their modules to this grand-master list. You can use the dumpbin utility with
-; the /headers option to get the "size of image" data (already in hex). If the
-; maximum size is too small a linker warning will occur. Modules can overlap when
-; they're mutually exclusive. This info is placed in the DLL's PE header by the
-; linker with the `-base:@$(TCLDIR)\win\coffbase.txt,<key>` option.
-
-tcl 0x10000000 0x00200000
-tcldde 0x10200000 0x00010000
-tclreg 0x10210000 0x00010000
-tk 0x10220000 0x00200000
-expect 0x10480000 0x00080000
-itcl 0x10500000 0x00080000
-itk 0x10580000 0x00080000
-bltlite 0x10600000 0x00080000
-blt 0x10680000 0x00080000
-iocpsock 0x10700000 0x00080000
-tls 0x10780000 0x00100000
-winico 0x10880000 0x00010000
-sample 0x108B0000 0x00010000
-tile 0x10900000 0x00080000
-memchan 0x109D0000 0x00010000
-tdom 0x109E0000 0x00080000
-tclvfs 0x10A70000 0x00010000
-tkvideo 0x10B00000 0x00010000
-tclsdl 0x10B20000 0x00080000
-vqtcl 0x10C00000 0x00010000
-tdbc 0x10C40000 0x00010000
-thread 0x10C80000 0x00020000
-nsf 0x10ca0000 0x00080000
-;
-; insert new packages here
-;
-snack 0x1E000000 0x00400000
-sound 0x1E400000 0x00400000
-snackogg 0x1E800000 0x00200000
diff --git a/win/rules.vc b/win/rules.vc index 2ee8f0e..958c888 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -394,7 +394,7 @@ MSG = ^ # If INSTALLDIR set to tcl installation root dir then reset to the
-# lib dir for installing extensions
+# lib dir for installing extensions
!if exist("$(_INSTALLDIR)\include\tcl.h")
_INSTALLDIR=$(_INSTALLDIR)\lib
!endif
@@ -547,7 +547,7 @@ NMAKEHLPC = $(_TCLDIR)\win\nmakehlp.c # The following macros are set:
# OPTIMIZATIONS - the compiler flags to be used for optimized builds
# DEBUGFLAGS - the compiler flags to be used for debug builds
-# LINKERFLAGS - Flags passed to the linker
+# LINKERFLAGS - Flags passed to the linker
#
# Note that these are the compiler settings *available*, not those
# that will be *used*. The latter depends on the OPTS macro settings
@@ -1132,8 +1132,8 @@ tklibs = "$(TKSTUBLIB)" "$(TKIMPLIB)" !endif # $(DOING_TK) || $(NEED_TK)
# Various output paths
-PRJIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
-PRJLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT)
+PRJIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX:t=).lib
+PRJLIBNAME = $(PROJECT)$(VERSION)$(SUFX:t=).$(EXT)
PRJLIB = $(OUT_DIR)\$(PRJLIBNAME)
PRJSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib
@@ -1270,7 +1270,7 @@ USE_WIDECHAR_API = 0 !endif
!if $(USE_WIDECHAR_API)
-COMPILERFLAGS = $(COMPILERFLAGS) /DUNICODE /D_UNICODE
+COMPILERFLAGS = $(COMPILERFLAGS) /DUNICODE /D_UNICODE
!endif
# Like the TEA system only set this non empty for non-Tk extensions
@@ -1280,7 +1280,7 @@ COMPILERFLAGS = $(COMPILERFLAGS) /DUNICODE /D_UNICODE PKGNAMEFLAGS = -DPACKAGE_NAME="\"$(PRJ_PACKAGE_TCLNAME)\"" \
-DPACKAGE_TCLNAME="\"$(PRJ_PACKAGE_TCLNAME)\"" \
-DPACKAGE_VERSION="\"$(DOTVERSION)\"" \
- -DMODULE_SCOPE=extern
+ -DMODULE_SCOPE=extern
!endif
# crt picks the C run time based on selected OPTS
@@ -1373,7 +1373,7 @@ pkgcflags_nostubs = $(appcflags_nostubs) $(PKGNAMEFLAGS) -DBUILD_$(PROJECT) # compiled with another VC version. Check for this and fix accordingly.
stubscflags = $(cflags) $(PKGNAMEFLAGS) $(PRJ_DEFINES) $(OPTDEFINES) -Zl -DSTATIC_BUILD $(INCLUDES)
-# Link flags
+# Link flags
!if $(DEBUG)
ldebug = -debug -debugtype:cv
@@ -1389,25 +1389,13 @@ ldebug = $(ldebug) -debug -debugtype:cv ldebug= $(ldebug) -profile
!endif
-### Declarations common to all linker versions
+### Declarations common to all linker versions
lflags = -nologo -machine:$(MACHINE) $(LINKERFLAGS) $(ldebug)
!if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900
lflags = $(lflags) -nodefaultlib:libucrt.lib
!endif
-# Old linkers (Visual C++ 6 in particular) will link for fast loading
-# on Win98. Since we do not support Win98 any more, we specify nowin98
-# as recommended for NT and later. However, this is only required by
-# IX86 on older compilers and only needed if we are not doing a static build.
-
-!if "$(MACHINE)" == "IX86" && !$(STATIC_BUILD)
-!if [nmakehlp -l -opt:nowin98 $(LINKER_TESTFLAGS)]
-# Align sections for PE size savings.
-lflags = $(lflags) -opt:nowin98
-!endif
-!endif
-
dlllflags = $(lflags) -dll
conlflags = $(lflags) -subsystem:console
guilflags = $(lflags) -subsystem:windows
@@ -1452,9 +1440,9 @@ RESCMD = $(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" \ -DCOMMAVERSION=$(DOTVERSION:.=,),0 \
-DDOTVERSION=\"$(DOTVERSION)\" \
-DVERSION=\"$(VERSION)\" \
- -DSUFX=\"$(SUFX)\" \
- -DPROJECT=\"$(PROJECT)\" \
- -DPRJLIBNAME=\"$(PRJLIBNAME)\"
+ -DSUFX=\"$(SUFX:t=)\" \
+ -DPROJECT=\"$(PROJECT)\" \
+ -DPRJLIBNAME=\"$(PRJLIBNAME)\"
!ifndef DEFAULT_BUILD_TARGET
DEFAULT_BUILD_TARGET = $(PROJECT)
@@ -1551,7 +1539,7 @@ default-shell: default-setup $(PROJECT) @if exist $(LIBDIR) for %f in ("$(LIBDIR)\*.tcl") do @$(COPY) %f "$(OUT_DIR)"
$(DEBUGGER) $(TCLSH)
-# Generation of Windows version resource
+# Generation of Windows version resource
!ifdef RCFILE
# Note: don't use $** in below rule because there may be other dependencies
@@ -1590,7 +1578,7 @@ BEGIN VALUE "OriginalFilename", PRJLIBNAME
VALUE "FileVersion", DOTVERSION
VALUE "ProductName", "Package " PROJECT " for Tcl"
- VALUE "ProductVersion", DOTVERSION
+ VALUE "ProductVersion", DOTVERSION
END
END
BLOCK "VarFileInfo"
diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 9d37a41..dc8bba7 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -182,7 +182,7 @@ TclpInitPlatform(void) void TclpInitLibraryPath( char **valuePtr, - size_t *lengthPtr, + unsigned int *lengthPtr, Tcl_Encoding *encodingPtr) { #define LIBRARY_SIZE 64 @@ -345,7 +345,7 @@ AppendEnvironment( static void InitializeDefaultLibraryDir( char **valuePtr, - size_t *lengthPtr, + unsigned int *lengthPtr, Tcl_Encoding *encodingPtr) { HMODULE hModule = TclWinGetTclInstance(); @@ -396,7 +396,7 @@ InitializeDefaultLibraryDir( static void InitializeSourceLibraryDir( char **valuePtr, - size_t *lengthPtr, + unsigned int *lengthPtr, Tcl_Encoding *encodingPtr) { HMODULE hModule = TclWinGetTclInstance(); diff --git a/win/tclWinSock.c b/win/tclWinSock.c index ee6be96..1c004838 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -360,7 +360,7 @@ printaddrinfolist( void InitializeHostName( char **valuePtr, - size_t *lengthPtr, + unsigned int *lengthPtr, Tcl_Encoding *encodingPtr) { TCHAR tbuf[MAX_COMPUTERNAME_LENGTH + 1]; |