summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--changes44
-rw-r--r--generic/tcl.decls26
-rw-r--r--generic/tcl.h8
-rw-r--r--generic/tclDecls.h18
-rw-r--r--generic/tclHash.c61
-rw-r--r--generic/tclInt.h6
-rw-r--r--generic/tclLiteral.c23
-rw-r--r--generic/tclNamesp.c17
-rw-r--r--generic/tclOOBasic.c13
-rw-r--r--generic/tclStubInit.c4
-rw-r--r--tests/namespace.test13
-rw-r--r--win/rules-ext.vc2
-rw-r--r--win/rules.vc79
13 files changed, 167 insertions, 147 deletions
diff --git a/changes b/changes
index ec8beb1..f89704b 100644
--- a/changes
+++ b/changes
@@ -8234,7 +8234,7 @@ Dropped support for OS X versions less than 10.4 (Tiger) (fellows)
2013-05-16 (platform support) mingw-4.0 (nijtmans)
-2013-05-19 (platform support) FreeBSD updates (gahr)
+2013-05-19 (platform support) FreeBSD updates (cerutti)
2013-05-20 (bug fix)[3613567] access error temp file creation (keene)
@@ -8657,7 +8657,7 @@ improvements to regexp engine from Postgres (lane,porter,fellows,seltenreich)
2016-05-21 (bug)[f7d4e] [namespace delete] performance (fellows)
-2016-06-02 (TIP 447) execution time verbosity option (gahr)
+2016-06-02 (TIP 447) execution time verbosity option (cerutti)
=> tcltest 2.4.0
2016-06-16 (bug)[16828b] crash due to [vwait] trace undo fail (dah,porter)
@@ -8796,6 +8796,45 @@ improvements to regexp engine from Postgres (lane,porter,fellows,seltenreich)
--- Released 8.6.7, August 9, 2017 --- http://core.tcl.tk/tcl/ for details
+2017-08-10 [array names -regexp] supports backrefs (goth)
+
+2017-08-10 Fix gcc build failures due to #pragma placement (cassoff,fellows)
+
+2017-08-29 (bug)[b50fb2] exec redir append stdout and stderr to file (coulter)
+
+2017-08-31 (bug)[2a9465] http state 100 continue handling broken (oehlmann)
+=> http 2.8.12
+
+2017-09-02 (bug)[0e4d88] replace command, delete trace kills namespace (porter)
+
+2017-10-19 (bug)[1a5655] [info * methods] includes mixins (fellows)
+
+2017-10-23 tzdata updated to Olson's tzdata2017c (jima)
+
+2017-10-24 (bug)[fc1409] segfault in method cloning, oo-15.15 (coulter,fellows)
+
+2017-11-03 (bug)[6f2f83] More robust [load] for ReactOS (werner)
+
+2017-11-08 (bug)[3298012] Stop crash when hash tables overflow 32 bits (porter)
+
+2017-11-14 (bug)[5d6de6] Close failing case of [package prefer stable] (kupries)
+
+2017-11-17 (bug)[fab924] Fix misleading [load] message on Windows (oehlmann)
+
+2017-12-05 (bug)[4f6a1e] Crash when ensemble map and list are same (sebres)
+
+2017-12-06 (bug)[ce3a21] file normalize failure when tail is empty (porter)
+
+2017-12-08 (new)[TIP 477] nmake build system reform (nadkarni)
+
+2017-12-19 (bug)[586e71] EvalObjv exception handling at level #0 (sebres,porter)
+
+--- Released 8.6.8, December 22, 2017 --- http://core.tcl.tk/tcl/ for details
+
+Changes to 8.7a1 include all changes to the 8.6 line through 8.6.7,
+plus the following, which focuses on the high-level feature changes
+in this changeset (new minor version) rather than bug fixes:
+
2016-03-17 (bug)[0b8c38] socket accept callbacks always in global ns (porter)
*** POTENTIAL INCOMPATIBILITY ***
@@ -8836,7 +8875,6 @@ improvements to regexp engine from Postgres (lane,porter,fellows,seltenreich)
2017-06-23 (TIP 472) Support 0d as prefix of decimal numbers (iyer,griffin)
2017-08-31 (bug)[2a9465] http state 100 continue handling broken (oehlmann)
-=> http 2.8.12
2017-09-02 (bug)[0e4d88] replace command, delete trace kills namespace (porter)
diff --git a/generic/tcl.decls b/generic/tcl.decls
index b47268f..05b29f0 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -946,11 +946,11 @@ declare 265 {
declare 266 {
void Tcl_ValidateAllMemory(const char *file, int line)
}
-# Removed in 9.0
+# Removed in 9.0:
#declare 267 {
# void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList)
#}
-# Removed in 9.0
+# Removed in 9.0:
#declare 268 {
# void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList)
#}
@@ -979,18 +979,18 @@ declare 274 {
CONST84_RETURN char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
const char *version, int exact)
}
-# Removed in 9.0
+# Removed in 9.0:
#declare 275 {
# void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList)
#}
-# Removed in 9.0
+# Removed in 9.0:
#declare 276 {
# int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList)
#}
declare 277 {
Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options)
}
-# Removed in 9.0
+# Removed in 9.0:
#declare 278 {
# TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList)
#}
@@ -1499,13 +1499,15 @@ declare 420 {
int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr,
const Tcl_UniChar *uniPattern, int nocase)
}
-declare 421 {
- Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key)
-}
-declare 422 {
- Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
- const void *key, int *newPtr)
-}
+# Removed in 9.0, as it is actually a macro:
+#declare 421 {
+# Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key)
+#}
+# Removed in 9.0, as it is actually a macro:
+#declare 422 {
+# Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
+# const void *key, int *newPtr)
+#}
declare 423 {
void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType,
const Tcl_HashKeyType *typePtr)
diff --git a/generic/tcl.h b/generic/tcl.h
index 688d678..8d175ef 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -1127,9 +1127,7 @@ struct Tcl_HashEntry {
Tcl_HashEntry *nextPtr; /* Pointer to next entry in this hash bucket,
* or NULL for end of chain. */
Tcl_HashTable *tablePtr; /* Pointer to table containing entry. */
- void *hash; /* Hash value, stored as pointer to ensure
- * that the offsets of the fields in this
- * structure are not changed. */
+ unsigned int hash; /* Hash value. */
ClientData clientData; /* Application stores something here with
* Tcl_SetHashValue. */
union { /* Key has one of these forms: */
@@ -1224,10 +1222,10 @@ struct Tcl_HashTable {
* table. */
int rebuildSize; /* Enlarge table when numEntries gets to be
* this large. */
+ unsigned int mask; /* Mask value used in hashing function. */
int downShift; /* Shift count used in hashing function.
* Designed to use high-order bits of
* randomized keys. */
- int mask; /* Mask value used in hashing function. */
int keyType; /* Type of keys used in this table. It's
* either TCL_CUSTOM_KEYS, TCL_STRING_KEYS,
* TCL_ONE_WORD_KEYS, or an integer giving the
@@ -2540,10 +2538,8 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
* hash tables:
*/
-#undef Tcl_FindHashEntry
#define Tcl_FindHashEntry(tablePtr, key) \
(*((tablePtr)->findProc))(tablePtr, (const char *)(key))
-#undef Tcl_CreateHashEntry
#define Tcl_CreateHashEntry(tablePtr, key, newPtr) \
(*((tablePtr)->createProc))(tablePtr, (const char *)(key), newPtr)
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 8873dbf..4478a20 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -1211,12 +1211,8 @@ EXTERN int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs,
/* 420 */
EXTERN int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr,
const Tcl_UniChar *uniPattern, int nocase);
-/* 421 */
-EXTERN Tcl_HashEntry * Tcl_FindHashEntry(Tcl_HashTable *tablePtr,
- const void *key);
-/* 422 */
-EXTERN Tcl_HashEntry * Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
- const void *key, int *newPtr);
+/* Slot 421 is reserved */
+/* Slot 422 is reserved */
/* 423 */
EXTERN void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr,
int keyType, const Tcl_HashKeyType *typePtr);
@@ -2274,8 +2270,8 @@ typedef struct TclStubs {
int (*tcl_IsChannelExisting) (const char *channelName); /* 418 */
int (*tcl_UniCharNcasecmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 419 */
int (*tcl_UniCharCaseMatch) (const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); /* 420 */
- Tcl_HashEntry * (*tcl_FindHashEntry) (Tcl_HashTable *tablePtr, const void *key); /* 421 */
- Tcl_HashEntry * (*tcl_CreateHashEntry) (Tcl_HashTable *tablePtr, const void *key, int *newPtr); /* 422 */
+ void (*reserved421)(void);
+ void (*reserved422)(void);
void (*tcl_InitCustomHashTable) (Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); /* 423 */
void (*tcl_InitObjHashTable) (Tcl_HashTable *tablePtr); /* 424 */
ClientData (*tcl_CommandTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData); /* 425 */
@@ -3348,10 +3344,8 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_UniCharNcasecmp) /* 419 */
#define Tcl_UniCharCaseMatch \
(tclStubsPtr->tcl_UniCharCaseMatch) /* 420 */
-#define Tcl_FindHashEntry \
- (tclStubsPtr->tcl_FindHashEntry) /* 421 */
-#define Tcl_CreateHashEntry \
- (tclStubsPtr->tcl_CreateHashEntry) /* 422 */
+/* Slot 421 is reserved */
+/* Slot 422 is reserved */
#define Tcl_InitCustomHashTable \
(tclStubsPtr->tcl_InitCustomHashTable) /* 423 */
#define Tcl_InitObjHashTable \
diff --git a/generic/tclHash.c b/generic/tclHash.c
index 32c9aec..bf8da23 100644
--- a/generic/tclHash.c
+++ b/generic/tclHash.c
@@ -14,13 +14,6 @@
#include "tclInt.h"
/*
- * Prevent macros from clashing with function definitions.
- */
-
-#undef Tcl_FindHashEntry
-#undef Tcl_CreateHashEntry
-
-/*
* When there are this many entries per bucket, on average, rebuild the hash
* table to make it larger.
*/
@@ -35,7 +28,7 @@
*/
#define RANDOM_INDEX(tablePtr, i) \
- ((((i)*1103515245L) >> (tablePtr)->downShift) & (tablePtr)->mask)
+ ((((i)*1103515245UL) >> (tablePtr)->downShift) & (tablePtr)->mask)
/*
* Prototypes for the array hash key methods.
@@ -200,7 +193,7 @@ Tcl_InitCustomHashTable(
/*
*----------------------------------------------------------------------
*
- * Tcl_FindHashEntry --
+ * FindHashEntry --
*
* Given a hash table find the entry with a matching key.
*
@@ -214,14 +207,6 @@ Tcl_InitCustomHashTable(
*----------------------------------------------------------------------
*/
-Tcl_HashEntry *
-Tcl_FindHashEntry(
- Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */
- const void *key) /* Key to use to find matching entry. */
-{
- return (*((tablePtr)->findProc))(tablePtr, key);
-}
-
static Tcl_HashEntry *
FindHashEntry(
Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */
@@ -234,7 +219,7 @@ FindHashEntry(
/*
*----------------------------------------------------------------------
*
- * Tcl_CreateHashEntry --
+ * CreateHashEntry --
*
* Given a hash table with string keys, and a string key, find the entry
* with a matching key. If there is no matching entry, then create a new
@@ -252,17 +237,6 @@ FindHashEntry(
*----------------------------------------------------------------------
*/
-Tcl_HashEntry *
-Tcl_CreateHashEntry(
- Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */
- const void *key, /* Key to use to find or create matching
- * entry. */
- int *newPtr) /* Store info here telling whether a new entry
- * was created. */
-{
- return (*((tablePtr)->createProc))(tablePtr, key, newPtr);
-}
-
static Tcl_HashEntry *
CreateHashEntry(
Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */
@@ -274,7 +248,7 @@ CreateHashEntry(
register Tcl_HashEntry *hPtr;
const Tcl_HashKeyType *typePtr;
unsigned int hash;
- int index;
+ unsigned int index;
if (tablePtr->keyType == TCL_STRING_KEYS) {
typePtr = &tclStringHashKeyType;
@@ -308,7 +282,7 @@ CreateHashEntry(
for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
hPtr = hPtr->nextPtr) {
- if (hash != PTR2UINT(hPtr->hash)) {
+ if (hash != hPtr->hash) {
continue;
}
if (((void *) key == hPtr) || compareKeysProc((void *) key, hPtr)) {
@@ -321,7 +295,7 @@ CreateHashEntry(
} else {
for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
hPtr = hPtr->nextPtr) {
- if (hash != PTR2UINT(hPtr->hash)) {
+ if (hash != hPtr->hash) {
continue;
}
if (key == hPtr->key.oneWordValue) {
@@ -351,7 +325,7 @@ CreateHashEntry(
}
hPtr->tablePtr = tablePtr;
- hPtr->hash = UINT2PTR(hash);
+ hPtr->hash = hash;
hPtr->nextPtr = tablePtr->buckets[index];
tablePtr->buckets[index] = hPtr;
tablePtr->numEntries++;
@@ -393,7 +367,7 @@ Tcl_DeleteHashEntry(
const Tcl_HashKeyType *typePtr;
Tcl_HashTable *tablePtr;
Tcl_HashEntry **bucketPtr;
- int index;
+ unsigned int index;
tablePtr = entryPtr->tablePtr;
@@ -410,9 +384,9 @@ Tcl_DeleteHashEntry(
if (typePtr->hashKeyProc == NULL
|| typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
- index = RANDOM_INDEX(tablePtr, PTR2INT(entryPtr->hash));
+ index = RANDOM_INDEX(tablePtr, entryPtr->hash);
} else {
- index = PTR2UINT(entryPtr->hash) & tablePtr->mask;
+ index = entryPtr->hash & tablePtr->mask;
}
bucketPtr = &tablePtr->buckets[index];
@@ -767,14 +741,14 @@ HashArrayKey(
void *keyPtr) /* Key from which to compute hash value. */
{
register const int *array = (const int *) keyPtr;
- register unsigned int result;
+ register TCL_HASH_TYPE result;
int count;
for (result = 0, count = tablePtr->keyType; count > 0;
count--, array++) {
result += *array;
}
- return (TCL_HASH_TYPE) result;
+ return result;
}
/*
@@ -863,7 +837,7 @@ HashStringKey(
void *keyPtr) /* Key from which to compute hash value. */
{
register const char *string = keyPtr;
- register unsigned int result;
+ register TCL_HASH_TYPE result;
register char c;
/*
@@ -903,7 +877,7 @@ HashStringKey(
result += (result << 3) + UCHAR(c);
}
}
- return (TCL_HASH_TYPE) result;
+ return result;
}
/*
@@ -985,7 +959,8 @@ static void
RebuildTable(
register Tcl_HashTable *tablePtr) /* Table to enlarge. */
{
- int count, index, oldSize = tablePtr->numBuckets;
+ int count, oldSize = tablePtr->numBuckets;
+ unsigned int index;
Tcl_HashEntry **oldBuckets = tablePtr->buckets;
register Tcl_HashEntry **oldChainPtr, **newChainPtr;
register Tcl_HashEntry *hPtr;
@@ -1038,9 +1013,9 @@ RebuildTable(
*oldChainPtr = hPtr->nextPtr;
if (typePtr->hashKeyProc == NULL
|| typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
- index = RANDOM_INDEX(tablePtr, PTR2INT(hPtr->hash));
+ index = RANDOM_INDEX(tablePtr, hPtr->hash);
} else {
- index = PTR2UINT(hPtr->hash) & tablePtr->mask;
+ index = hPtr->hash & tablePtr->mask;
}
hPtr->nextPtr = tablePtr->buckets[index];
tablePtr->buckets[index] = hPtr;
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 72fce60..f980980 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -1493,11 +1493,11 @@ typedef struct LiteralEntry {
* NULL if end of chain. */
Tcl_Obj *objPtr; /* Points to Tcl object that holds the
* literal's bytes and length. */
- int refCount; /* If in an interpreter's global literal
+ size_t refCount; /* If in an interpreter's global literal
* table, the number of ByteCode structures
* that share the literal object; the literal
* entry can be freed when refCount drops to
- * 0. If in a local literal table, -1. */
+ * 0. If in a local literal table, (size_t)-1. */
Namespace *nsPtr; /* Namespace in which this literal is used. We
* try to avoid sharing literal non-FQ command
* names among different namespaces to reduce
@@ -1517,7 +1517,7 @@ typedef struct LiteralTable {
* table. */
int rebuildSize; /* Enlarge table when numEntries gets to be
* this large. */
- int mask; /* Mask value used in hashing function. */
+ unsigned int mask; /* Mask value used in hashing function. */
} LiteralTable;
/*
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c
index 7acc9ad..003884d 100644
--- a/generic/tclLiteral.c
+++ b/generic/tclLiteral.c
@@ -186,7 +186,7 @@ TclCreateLiteral(
{
LiteralTable *globalTablePtr = &iPtr->literalTable;
LiteralEntry *globalPtr;
- int globalHash;
+ unsigned int globalHash;
Tcl_Obj *objPtr;
/*
@@ -393,7 +393,8 @@ TclRegisterLiteral(
LiteralEntry *globalPtr, *localPtr;
Tcl_Obj *objPtr;
unsigned hash;
- int localHash, objIndex, new;
+ unsigned int localHash;
+ int objIndex, new;
Namespace *nsPtr;
if (length < 0) {
@@ -537,7 +538,8 @@ TclHideLiteral(
{
LiteralEntry **nextPtrPtr, *entryPtr, *lPtr;
LiteralTable *localTablePtr = &envPtr->localLitTable;
- int localHash, length;
+ unsigned int localHash;
+ int length;
const char *bytes;
Tcl_Obj *newObjPtr;
@@ -556,7 +558,7 @@ TclHideLiteral(
lPtr->objPtr = newObjPtr;
bytes = TclGetStringFromObj(newObjPtr, &length);
- localHash = (HashString(bytes, length) & localTablePtr->mask);
+ localHash = HashString(bytes, length) & localTablePtr->mask;
nextPtrPtr = &localTablePtr->buckets[localHash];
for (entryPtr=*nextPtrPtr ; entryPtr!=NULL ; entryPtr=*nextPtrPtr) {
@@ -612,7 +614,7 @@ TclAddLiteralObj(
lPtr = &envPtr->literalArrayPtr[objIndex];
lPtr->objPtr = objPtr;
Tcl_IncrRefCount(objPtr);
- lPtr->refCount = -1; /* i.e., unused */
+ lPtr->refCount = (size_t)-1; /* i.e., unused */
lPtr->nextPtr = NULL;
if (litPtrPtr) {
@@ -809,7 +811,8 @@ TclReleaseLiteral(
LiteralTable *globalTablePtr;
register LiteralEntry *entryPtr, *prevPtr;
const char *bytes;
- int length, index;
+ int length;
+ unsigned int index;
if (iPtr == NULL) {
goto done;
@@ -828,15 +831,13 @@ TclReleaseLiteral(
for (prevPtr=NULL, entryPtr=globalTablePtr->buckets[index];
entryPtr!=NULL ; prevPtr=entryPtr, entryPtr=entryPtr->nextPtr) {
if (entryPtr->objPtr == objPtr) {
- entryPtr->refCount--;
-
/*
* If the literal is no longer being used by any ByteCode, delete
* the entry then remove the reference corresponding to the global
* literal table entry (decrement the ref count of the object).
*/
- if (entryPtr->refCount == 0) {
+ if (entryPtr->refCount-- <= 1) {
if (prevPtr == NULL) {
globalTablePtr->buckets[index] = entryPtr->nextPtr;
} else {
@@ -954,8 +955,8 @@ RebuildLiteralTable(
register LiteralEntry *entryPtr;
LiteralEntry **bucketPtr;
const char *bytes;
- unsigned int oldSize;
- int count, index, length;
+ unsigned int oldSize, index;
+ int count, length;
oldSize = tablePtr->numBuckets;
oldBuckets = tablePtr->buckets;
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 7395216..f510fed 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -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) {
- 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/tclOOBasic.c b/generic/tclOOBasic.c
index b2c06a7..d874cba 100644
--- a/generic/tclOOBasic.c
+++ b/generic/tclOOBasic.c
@@ -1206,22 +1206,10 @@ TclOOCopyObjectCmd(
o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, NULL, NULL);
} else {
const char *name, *namespaceName;
- Tcl_DString buffer;
name = TclGetString(objv[2]);
- Tcl_DStringInit(&buffer);
if (name[0] == '\0') {
name = NULL;
- } else if (name[0]!=':' || name[1]!=':') {
- Interp *iPtr = (Interp *) interp;
-
- if (iPtr->varFramePtr != NULL) {
- Tcl_DStringAppend(&buffer,
- iPtr->varFramePtr->nsPtr->fullName, -1);
- }
- TclDStringAppendLiteral(&buffer, "::");
- Tcl_DStringAppend(&buffer, name, -1);
- name = Tcl_DStringValue(&buffer);
}
/*
@@ -1243,7 +1231,6 @@ TclOOCopyObjectCmd(
}
o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, name, namespaceName);
- Tcl_DStringFree(&buffer);
}
if (o2Ptr == NULL) {
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index fdde1a6..d26b67c 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -1176,8 +1176,8 @@ const TclStubs tclStubs = {
Tcl_IsChannelExisting, /* 418 */
Tcl_UniCharNcasecmp, /* 419 */
Tcl_UniCharCaseMatch, /* 420 */
- Tcl_FindHashEntry, /* 421 */
- Tcl_CreateHashEntry, /* 422 */
+ 0, /* 421 */
+ 0, /* 422 */
Tcl_InitCustomHashTable, /* 423 */
Tcl_InitObjHashTable, /* 424 */
Tcl_CommandTraceInfo, /* 425 */
diff --git a/tests/namespace.test b/tests/namespace.test
index ed1eed6..a6c4932 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/win/rules-ext.vc b/win/rules-ext.vc
index 58c70fa..531e070 100644
--- a/win/rules-ext.vc
+++ b/win/rules-ext.vc
@@ -35,7 +35,7 @@ macro to the name of the project makefile.
!endif
# First locate the Tcl directory that we are working with.
-!ifdef TCLDIR
+!if "$(TCLDIR)" != ""
_RULESDIR = $(TCLDIR:/=\)
diff --git a/win/rules.vc b/win/rules.vc
index 7fc51c1..2c61e2d 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 = 0
+RULES_VERSION_MINOR = 1
# The PROJECT macro must be defined by parent makefile.
!if "$(PROJECT)" == ""
@@ -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
@@ -535,7 +535,6 @@ NMAKEHLPC = $(_TCLDIR)\win\nmakehlp.c
# We always build nmakehlp even if it exists since we do not know
# what source it was built from.
-!message *** Using $(NMAKEHLPC)
!if [$(cc32) -nologo "$(NMAKEHLPC)" -link -subsystem:console > nul]
!endif
@@ -547,7 +546,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
@@ -590,7 +589,6 @@ FPOPTS = $(FPOPTS) -QI0f
OPTIMIZATIONS = $(FPOPTS)
!if [nmakehlp -c -O2]
-!message *** Compiler has 'Optimizations'
OPTIMIZING = 1
OPTIMIZATIONS = $(OPTIMIZATIONS) -O2
!else
@@ -1063,7 +1061,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)
@@ -1077,12 +1075,24 @@ TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)"
!if $(TCLINSTALL) # Building against an installed Tcl
+# 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
+!if !exist("$(TCLSH)")
+TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX:t=).exe
+!endif
+
TCLSTUBLIB = $(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib
TCLIMPLIB = $(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).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
+!endif
TCL_LIBRARY = $(_TCLDIR)\lib
TCLREGLIB = $(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib
TCLDDELIB = $(_TCLDIR)\lib\tcldde14$(SUFX:t=).lib
@@ -1095,8 +1105,16 @@ 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
+!endif
TCLSTUBLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib
TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).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
+!endif
TCL_LIBRARY = $(_TCLDIR)\library
TCLREGLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib
TCLDDELIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde14$(SUFX:t=).lib
@@ -1140,11 +1158,23 @@ TK_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)"
WISH = $(_TKDIR)\bin\$(WISHNAME)
TKSTUBLIB = $(_TKDIR)\lib\$(TKSTUBLIBNAME)
TKIMPLIB = $(_TKDIR)\lib\$(TKIMPLIBNAME)
+# When building extensions, may be linking against Tk that does not add
+# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
+!if !exist("$(TKIMPLIB)")
+TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX:t=).lib
+TKIMPLIB = $(_TKDIR)\lib\$(TKIMPLIBNAME)
+!endif
TK_INCLUDES = -I"$(_TKDIR)\include"
!else # Building against Tk sources
WISH = $(_TKDIR)\win\$(BUILDDIRTOP)\$(WISHNAME)
TKSTUBLIB = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKSTUBLIBNAME)
TKIMPLIB = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKIMPLIBNAME)
+# When building extensions, may be linking against Tk that does not add
+# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
+!if !exist("$(TKIMPLIB)")
+TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX:t=).lib
+TKIMPLIB = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKIMPLIBNAME)
+!endif
TK_INCLUDES = -I"$(_TKDIR)\generic" -I"$(_TKDIR)\win" -I"$(_TKDIR)\xlib"
!endif # TKINSTALL
tklibs = "$(TKSTUBLIB)" "$(TKIMPLIB)"
@@ -1153,8 +1183,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
@@ -1291,7 +1321,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
@@ -1301,7 +1331,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
@@ -1394,7 +1424,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
@@ -1410,25 +1440,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
@@ -1473,9 +1491,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)
@@ -1572,7 +1590,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
@@ -1611,7 +1629,7 @@ BEGIN
VALUE "OriginalFilename", PRJLIBNAME
VALUE "FileVersion", DOTVERSION
VALUE "ProductName", "Package " PROJECT " for Tcl"
- VALUE "ProductVersion", DOTVERSION
+ VALUE "ProductVersion", DOTVERSION
END
END
BLOCK "VarFileInfo"
@@ -1717,7 +1735,6 @@ TCLNMAKECONFIG = "$(OUT_DIR)\tcl.nmake"
!message *** Output directory will be '$(OUT_DIR)'
!message *** Installation, if selected, will be in '$(_INSTALLDIR)'
!message *** Suffix for binaries will be '$(SUFX)'
-!message *** Compiler version $(VCVER). Target machine is $(MACHINE)
-!message *** Host architecture is $(NATIVE_ARCH)
+!message *** Compiler version $(VCVER). Target $(MACHINE), host $(NATIVE_ARCH).
!endif # ifdef _RULES_VC