summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2012-07-04 07:09:40 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2012-07-04 07:09:40 (GMT)
commit9dee089fa2567d307056363c20eb69c53b4e1655 (patch)
treef601a0cf95af6e9aeea8f330063f37565515f418
parent6de91b6b7d469c5f8d511700b75689df23e43fd1 (diff)
parentd3104ac52bdca1849c62445954323c841fcd5009 (diff)
downloadtcl-9dee089fa2567d307056363c20eb69c53b4e1655.zip
tcl-9dee089fa2567d307056363c20eb69c53b4e1655.tar.gz
tcl-9dee089fa2567d307056363c20eb69c53b4e1655.tar.bz2
merge trunk
-rw-r--r--ChangeLog86
-rw-r--r--doc/GetIndex.310
-rw-r--r--doc/msgcat.n15
-rw-r--r--generic/tclAssembly.c6
-rw-r--r--generic/tclBasic.c18
-rw-r--r--generic/tclCmdAH.c20
-rw-r--r--generic/tclCompCmds.c4
-rw-r--r--generic/tclCompCmdsSZ.c3
-rw-r--r--generic/tclCompExpr.c2
-rw-r--r--generic/tclCompile.c19
-rw-r--r--generic/tclCompile.h13
-rw-r--r--generic/tclConfig.c4
-rw-r--r--generic/tclEncoding.c4
-rw-r--r--generic/tclEnsemble.c16
-rw-r--r--generic/tclEnv.c4
-rw-r--r--generic/tclFileName.c35
-rw-r--r--generic/tclFileSystem.h42
-rw-r--r--generic/tclIO.c8
-rw-r--r--generic/tclIORChan.c11
-rw-r--r--generic/tclIOSock.c15
-rw-r--r--generic/tclIOUtil.c149
-rw-r--r--generic/tclInt.decls5
-rw-r--r--generic/tclInt.h19
-rw-r--r--generic/tclIntPlatDecls.h10
-rw-r--r--generic/tclLoad.c30
-rw-r--r--generic/tclNamesp.c17
-rw-r--r--generic/tclOO.c6
-rw-r--r--generic/tclOOBasic.c2
-rw-r--r--generic/tclPathObj.c40
-rw-r--r--generic/tclPkg.c6
-rw-r--r--generic/tclProc.c2
-rw-r--r--generic/tclStubInit.c3
-rw-r--r--generic/tclTrace.c22
-rw-r--r--generic/tclUtil.c37
-rw-r--r--generic/tclZlib.c12
-rw-r--r--library/msgcat/msgcat.tcl64
-rw-r--r--library/msgcat/pkgIndex.tcl2
-rw-r--r--tests/encoding.test8
-rw-r--r--tests/msgcat.test4
-rw-r--r--unix/Makefile.in23
-rwxr-xr-xunix/configure27
-rw-r--r--unix/configure.in9
-rw-r--r--unix/tcl.m414
-rw-r--r--unix/tclConfig.sh.in2
-rw-r--r--unix/tclLoadDl.c2
-rw-r--r--unix/tclLoadDyld.c2
-rw-r--r--unix/tclLoadShl.c6
-rw-r--r--unix/tclUnixChan.c4
-rw-r--r--unix/tclUnixFCmd.c14
-rw-r--r--unix/tclUnixFile.c24
-rw-r--r--unix/tclUnixPort.h6
-rw-r--r--unix/tclUnixSock.c7
-rw-r--r--win/Makefile.in4
-rw-r--r--win/tclWinFCmd.c4
-rw-r--r--win/tclWinFile.c14
-rw-r--r--win/tclWinLoad.c2
-rw-r--r--win/tclWinPipe.c14
-rw-r--r--win/tclWinReg.c8
-rw-r--r--win/tclWinSock.c8
59 files changed, 576 insertions, 391 deletions
diff --git a/ChangeLog b/ChangeLog
index e7f5fc3..d1a2d6a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,7 +1,60 @@
+2012-07-03 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclUtil.c (TclDStringAppendObj, TclDStringAppendDString):
+ * generic/tclInt.h (TclDStringAppendLiteral, TclDStringClear):
+ * generic/tclCompile.h (TclDStringAppendToken): Added wrappers to make
+ common cases of appending to Tcl_DStrings simpler to write. Prompted
+ by looking at [FRQ 1357401] (these are an _internal_ implementation of
+ that FRQ).
+
+2012-06-29 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * library/msgcat/msgcat.tcl: Add tn, ro_MO and ru_MO to msgcat.
+
+2012-06-29 Harald Oehlmann <harald.oehlmann@elmicron.de>
+
+ * library/msgcat/msgcat.tcl: [Bug 3536888] Locale guessing of msgcat
+ * library/msgcat/pkgIndex.tcl: fails on (some) Windows 7. Bump to 1.4.5
+ * unix/Makefile.in
+ * win/Makefile.in
+
+2012-06-29 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/GetIndex.3: Reinforced the description of the requirement for
+ the tables of names to index over to be static, following posting to
+ tcl-core by Brian Griffin about a bug caused by Tktreectrl not obeying
+ this rule correctly. This does not represent a functionality change,
+ merely a clearer documentation of a long-standing constraint.
+
+2012-06-26 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * unix/tcl.m4: Let Cygwin shared build link with
+ * unix/configure.in: zlib1.dll, not cygz.dll (two less
+ * unix/configure: dependencies on cygwin-specific dll's)
+ * unix/Makefile.in:
+
+2012-06-26 Reinhard Max <max@suse.de>
+
+ * generic/tclIOSock.c: Use EAI_SYSTEM only if it exists.
+ * unix/tclUnixSock.c:
+
+2012-06-25 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclFileSystem.h: [Bug 3024359] Make sure that the
+ * generic/tclIOUtil.c: per-thread cache of the list of file systems
+ * generic/tclPathObj.c: currently registered is only updated at times
+ when no active loops are traversing it. Also reduce the amount of
+ epoch storing and checking to where it can make a difference.
+
+2012-06-25 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCmdAH.c (EncodingDirsObjCmd): [Bug 3537605]: Do the right
+ thing when reporting errors with the number of arguments.
+
2012-06-25 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclfileName.c: [Patch #1536227]: Cygwin network pathname
- * tests/fileName.test: support
+ * generic/tclfileName.c: [Patch 1536227]: Cygwin network pathname
+ * tests/fileName.test: support.
2012-06-23 Jan Nijtmans <nijtmans@users.sf.net>
@@ -16,15 +69,15 @@
2012-06-21 Jan Nijtmans <nijtmans@users.sf.net>
- * win/tclWinReg.c: [Bug #3362446]: registry keys command fails
- * tests/registry.test: with 8.5/8.6
+ * win/tclWinReg.c: [Bug 3362446]: registry keys command fails
+ * tests/registry.test: with 8.5/8.6
2012-06-11 Don Porter <dgp@users.sourceforge.net>
- * generic/tclBasic.c: [Bug 3532959] Make sure the lifetime management
- * generic/tclProc.c: of entries in the linePBodyPtr hash table can
- * tests/proc.test: tolerate either order of teardown, interp first,
- or Proc first.
+ * generic/tclBasic.c: [Bug 3532959]: Make sure the lifetime
+ * generic/tclProc.c: management of entries in the linePBodyPtr hash
+ * tests/proc.test: table can tolerate either order of teardown,
+ interp first, or Proc first.
2012-06-08 Don Porter <dgp@users.sourceforge.net>
@@ -32,7 +85,7 @@
* unix/tclUnixPort.h: Thanks Joe English.
* unix/configure: autoconf 2.13
- * unix/tclUnixPort.h: [Bug 3530533] Centralize #include <pthread.h>
+ * unix/tclUnixPort.h: [Bug 3530533]: Centralize #include <pthread.h>
* unix/tclUnixThrd.c: in the tclUnixPort.h header so that old unix
systems that need inclusion in all compilation units are supported.
@@ -5057,8 +5110,8 @@
2010-01-21 Miguel Sofer <msofer@users.sf.net>
- * generic/tclCompile.h: NRE-enable direct eval on BC spoilage
- * generic/tclExecute.c: [Bug 2910748]
+ * generic/tclCompile.h: [Bug 2910748]: NRE-enable direct eval on BC
+ * generic/tclExecute.c: spoilage.
* tests/nre.test:
2010-01-19 Donal K. Fellows <dkf@users.sf.net>
@@ -6047,14 +6100,15 @@
2009-10-05 Andreas Kupries <andreask@activestate.com>
* library/safe.tcl (AliasGlob): Fixed conversion of catch to
- try/finally, it had an 'on ok msg' branch missing, causing a
- silent error immediately, and bogus glob results, breaking
- search for Tcl modules.
+ try/finally, it had an 'on ok msg' branch missing, causing a silent
+ error immediately, and bogus glob results, breaking search for Tcl
+ modules.
2009-10-04 Daniel Steffen <das@users.sourceforge.net>
- * macosx/tclMacOSXBundle.c: Workaround CF memory managment bug in
- * unix/tclUnixInit.c: Mac OS X 10.4 & earlier. [Bug 2569449]
+ * macosx/tclMacOSXBundle.c: [Bug 2569449]: Workaround CF memory
+ * unix/tclUnixInit.c: managment bug in Mac OS X 10.4 &
+ earlier.
2009-10-02 Kevin B. Kenny <kennykb@acm.org>
diff --git a/doc/GetIndex.3 b/doc/GetIndex.3
index f60feb5..50607ae 100644
--- a/doc/GetIndex.3
+++ b/doc/GetIndex.3
@@ -32,10 +32,16 @@ table entry.
.AP "const char *const" *tablePtr in
An array of null-terminated strings. The end of the array is marked
by a NULL string pointer.
+Note that references to the \fItablePtr\fR may be retained in the
+internal representation of \fIobjPtr\fR, so this should represent the
+address of a statically-allocated array.
.AP "const void" *structTablePtr in
An array of arbitrary type, typically some \fBstruct\fR type.
The first member of the structure must be a null-terminated string.
The size of the structure is given by \fIoffset\fR.
+Note that references to the \fIstructTablePtr\fR may be retained in the
+internal representation of \fIobjPtr\fR, so this should represent the
+address of a statically-allocated array of structures.
.AP int offset in
The offset to add to structTablePtr to get to the next entry.
The end of the array is marked by a NULL string pointer.
@@ -51,10 +57,10 @@ The index of the string in \fItablePtr\fR that matches the value of
.BE
.SH DESCRIPTION
.PP
-This procedure provides an efficient way for looking up keywords,
+These procedures provide an efficient way for looking up keywords,
switch names, option names, and similar things where the value of
an object must be one of a predefined set of values.
-\fIObjPtr\fR is compared against each of
+\fBTcl_GetIndexFromObj\fR compares \fIobjPtr\fR against each of
the strings in \fItablePtr\fR to find a match. A match occurs if
\fIobjPtr\fR's string value is identical to one of the strings in
\fItablePtr\fR, or if it is a non-empty unique abbreviation
diff --git a/doc/msgcat.n b/doc/msgcat.n
index d389757..595c85f 100644
--- a/doc/msgcat.n
+++ b/doc/msgcat.n
@@ -13,7 +13,7 @@ msgcat \- Tcl message catalog
.SH SYNOPSIS
\fBpackage require Tcl 8.5\fR
.sp
-\fBpackage require msgcat 1.4.2\fR
+\fBpackage require msgcat 1.4.5\fR
.sp
\fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR?
.sp
@@ -175,11 +175,14 @@ to extract its parts. The initial locale is then set by calling
language[_country][_modifier]
.CE
.PP
-On Windows, if none of those environment variables is set, msgcat will
-attempt to extract locale information from the
-registry. If all these attempts to discover an initial locale
-from the user's environment fail, msgcat defaults to an initial
-locale of
+On Windows and Cygwin, if none of those environment variables is set,
+msgcat will attempt to extract locale information from the registry.
+From Windows Vista on, the RFC4747 locale name "lang-script-country-options"
+is transformed to the locale as "lang_country_script" (Example:
+sr-Latn-CS -> sr_cs_latin). For Windows XP, the language id is
+transformed analoguously (Example: 0c1a -> sr_yu_cyrillic).
+If all these attempts to discover an initial locale from the user's
+environment fail, msgcat defaults to an initial locale of
.QW C .
.PP
When a locale is specified by the user, a
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 02144a1..83f4fe9 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -265,7 +265,7 @@ static int CheckStrictlyPositive(Tcl_Interp*, int);
static ByteCode * CompileAssembleObj(Tcl_Interp *interp,
Tcl_Obj *objPtr);
static void CompileEmbeddedScript(AssemblyEnv*, Tcl_Token*,
- TalInstDesc*);
+ const TalInstDesc*);
static int DefineLabel(AssemblyEnv* envPtr, const char* label);
static void DeleteMirrorJumpTable(JumptableInfo* jtPtr);
static void DupAssembleCodeInternalRep(Tcl_Obj* src,
@@ -350,7 +350,7 @@ static const Tcl_ObjType assembleCodeType = {
* Source instructions recognized in the Tcl Assembly Language (TAL)
*/
-TalInstDesc TalInstructionTable[] = {
+static const TalInstDesc TalInstructionTable[] = {
/* PUSH must be first, see the code near the end of TclAssembleCode */
{"push", ASSEM_PUSH, (INST_PUSH1<<8
| INST_PUSH4), 0, 1},
@@ -1768,7 +1768,7 @@ static void
CompileEmbeddedScript(
AssemblyEnv* assemEnvPtr, /* Assembly environment */
Tcl_Token* tokenPtr, /* Tcl_Token containing the script */
- TalInstDesc* instPtr) /* Instruction that determines whether
+ const TalInstDesc* instPtr) /* Instruction that determines whether
* the script is 'expr' or 'eval' */
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 0b02d0d..537750e 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -134,6 +134,8 @@ static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected,
static Tcl_NRPostProc NRCoroutineActivateCallback;
static Tcl_NRPostProc NRCoroutineCallerCallback;
static Tcl_NRPostProc NRCoroutineExitCallback;
+static int NRCommand(ClientData data[], Tcl_Interp *interp, int result);
+
static Tcl_NRPostProc NRRunObjProc;
static Tcl_NRPostProc NRTailcallEval;
static Tcl_ObjCmdProc OldMathFuncProc;
@@ -2610,7 +2612,7 @@ TclRenameCommand(
Tcl_DStringInit(&newFullName);
Tcl_DStringAppend(&newFullName, newNsPtr->fullName, -1);
if (newNsPtr != iPtr->globalNsPtr) {
- Tcl_DStringAppend(&newFullName, "::", 2);
+ TclDStringAppendLiteral(&newFullName, "::");
}
Tcl_DStringAppend(&newFullName, newTail, -1);
cmdPtr->refCount++;
@@ -3468,7 +3470,7 @@ Tcl_CreateMathFunc(
data->clientData = clientData;
Tcl_DStringInit(&bigName);
- Tcl_DStringAppend(&bigName, "::tcl::mathfunc::", -1);
+ TclDStringAppendLiteral(&bigName, "::tcl::mathfunc::");
Tcl_DStringAppend(&bigName, name, -1);
Tcl_CreateObjCommand(interp, Tcl_DStringValue(&bigName),
@@ -4363,7 +4365,7 @@ TclNRRunCallbacks(
return result;
}
-int
+static int
NRCommand(
ClientData data[],
Tcl_Interp *interp,
@@ -8593,7 +8595,7 @@ RewindCoroutine(
corPtr->eePtr->rewind = 1;
TclNRAddCallback(interp, RewindCoroutineCallback, state,
NULL, NULL, NULL);
- return NRInterpCoroutine(corPtr, interp, 0, NULL);
+ return TclNRInterpCoroutine(corPtr, interp, 0, NULL);
}
static void
@@ -8820,7 +8822,7 @@ NRCoroInjectObjCmd(
}
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]);
- if ((!cmdPtr) || (cmdPtr->nreProc != NRInterpCoroutine)) {
+ if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) {
Tcl_AppendResult(interp, "can only inject a command into a coroutine",
NULL);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE",
@@ -8849,7 +8851,7 @@ NRCoroInjectObjCmd(
}
int
-NRInterpCoroutine(
+TclNRInterpCoroutine(
ClientData clientData,
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
@@ -8971,12 +8973,12 @@ TclNRCoroutineObjCmd(
Tcl_DStringInit(&ds);
if (nsPtr != iPtr->globalNsPtr) {
Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
- Tcl_DStringAppend(&ds, "::", 2);
+ TclDStringAppendLiteral(&ds, "::");
}
Tcl_DStringAppend(&ds, procName, -1);
cmdPtr = (Command *) Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds),
- /*objProc*/ NULL, NRInterpCoroutine, corPtr, DeleteCoroutine);
+ /*objProc*/ NULL, TclNRInterpCoroutine, corPtr, DeleteCoroutine);
Tcl_DStringFree(&ds);
corPtr->cmdPtr = cmdPtr;
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 4292224..f09ee70 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -629,24 +629,26 @@ EncodingDirsObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
+ Tcl_Obj *dirListObj;
+
if (objc > 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "?dirList?");
+ Tcl_WrongNumArgs(interp, 2, objv, "?dirList?");
return TCL_ERROR;
}
- objc -= 1;
- objv += 1;
- if (objc == 1) {
+ if (objc == 2) {
Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath());
return TCL_OK;
}
- if (Tcl_SetEncodingSearchPath(objv[1]) == TCL_ERROR) {
+
+ dirListObj = objv[2];
+ if (Tcl_SetEncodingSearchPath(dirListObj) == TCL_ERROR) {
Tcl_AppendResult(interp, "expected directory list but got \"",
- TclGetString(objv[1]), "\"", NULL);
+ TclGetString(dirListObj), "\"", NULL);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "ENCODING", "BADPATH",
NULL);
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, objv[1]);
+ Tcl_SetObjResult(interp, dirListObj);
return TCL_OK;
}
@@ -1043,9 +1045,9 @@ TclMakeFileCommandSafe(
Tcl_DString oldBuf, newBuf;
Tcl_DStringInit(&oldBuf);
- Tcl_DStringAppend(&oldBuf, "::tcl::file::", -1);
+ TclDStringAppendLiteral(&oldBuf, "::tcl::file::");
Tcl_DStringInit(&newBuf);
- Tcl_DStringAppend(&newBuf, "tcl:file:", -1);
+ TclDStringAppendLiteral(&newBuf, "tcl:file:");
for (i=0 ; unsafeInfo[i].cmdName != NULL ; i++) {
if (unsafeInfo[i].unsafe) {
const char *oldName, *newName;
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 5b7e0a5..3540716 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -820,7 +820,7 @@ TclCompileDictForCmd(
*/
Tcl_DStringInit(&buffer);
- Tcl_DStringAppend(&buffer, varsTokenPtr[1].start, varsTokenPtr[1].size);
+ TclDStringAppendToken(&buffer, &varsTokenPtr[1]);
if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numVars,
&argv) != TCL_OK) {
Tcl_DStringFree(&buffer);
@@ -1961,7 +1961,7 @@ TclCompileForeachCmd(
*/
Tcl_DStringInit(&varList);
- Tcl_DStringAppend(&varList, tokenPtr[1].start, tokenPtr[1].size);
+ TclDStringAppendToken(&varList, &tokenPtr[1]);
code = Tcl_SplitList(interp, Tcl_DStringValue(&varList),
&varcList[loopIndex], &varvList[loopIndex]);
Tcl_DStringFree(&varList);
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index b950e21..8ed3a95 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -1558,8 +1558,7 @@ IssueSwitchJumpTable(
*/
Tcl_DStringInit(&buffer);
- Tcl_DStringAppend(&buffer, bodyToken[i]->start,
- bodyToken[i]->size);
+ TclDStringAppendToken(&buffer, bodyToken[i]);
hPtr = Tcl_CreateHashEntry(&jtPtr->hashTable,
Tcl_DStringValue(&buffer), &isNew);
if (isNew) {
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 4212b6d..890d518 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -2296,7 +2296,7 @@ CompileExprTree(
int length;
Tcl_DStringInit(&cmdName);
- Tcl_DStringAppend(&cmdName, "tcl::mathfunc::", -1);
+ TclDStringAppendLiteral(&cmdName, "tcl::mathfunc::");
p = TclGetStringFromObj(*funcObjv, &length);
funcObjv++;
Tcl_DStringAppend(&cmdName, p, length);
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 1d88e11..d4ca284 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1661,8 +1661,8 @@ TclCompileScript(
* have side effects that rely on the unmodified string.
*/
- Tcl_DStringSetLength(&ds, 0);
- Tcl_DStringAppend(&ds, tokenPtr[1].start,tokenPtr[1].size);
+ TclDStringClear(&ds);
+ TclDStringAppendToken(&ds, &tokenPtr[1]);
cmdPtr = (Command *) Tcl_FindCommand(interp,
Tcl_DStringValue(&ds),
@@ -2044,7 +2044,7 @@ TclCompileTokens(
for ( ; count > 0; count--, tokenPtr++) {
switch (tokenPtr->type) {
case TCL_TOKEN_TEXT:
- Tcl_DStringAppend(&textBuffer, tokenPtr->start, tokenPtr->size);
+ TclDStringAppendToken(&textBuffer, tokenPtr);
TclAdvanceLines(&envPtr->line, tokenPtr->start,
tokenPtr->start + tokenPtr->size);
break;
@@ -2091,9 +2091,7 @@ TclCompileTokens(
*/
if (Tcl_DStringLength(&textBuffer) > 0) {
- int literal = TclRegisterNewLiteral(envPtr,
- Tcl_DStringValue(&textBuffer),
- Tcl_DStringLength(&textBuffer));
+ int literal = TclRegisterDStringLiteral(envPtr, &textBuffer);
TclEmitPush(literal, envPtr);
numObjsToConcat++;
@@ -2120,9 +2118,7 @@ TclCompileTokens(
if (Tcl_DStringLength(&textBuffer) > 0) {
int literal;
- literal = TclRegisterNewLiteral(envPtr,
- Tcl_DStringValue(&textBuffer),
- Tcl_DStringLength(&textBuffer));
+ literal = TclRegisterDStringLiteral(envPtr, &textBuffer);
TclEmitPush(literal, envPtr);
numObjsToConcat++;
Tcl_DStringFree(&textBuffer);
@@ -2145,13 +2141,10 @@ TclCompileTokens(
*/
if (Tcl_DStringLength(&textBuffer) > 0) {
- int literal;
+ int literal = TclRegisterDStringLiteral(envPtr, &textBuffer);
- literal = TclRegisterNewLiteral(envPtr, Tcl_DStringValue(&textBuffer),
- Tcl_DStringLength(&textBuffer));
TclEmitPush(literal, envPtr);
numObjsToConcat++;
-
if (numCL) {
TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr,
numCL, clPosition);
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 58663fd..ba78c36 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -866,8 +866,7 @@ typedef struct {
*----------------------------------------------------------------
*/
-MODULE_SCOPE Tcl_NRPostProc NRCommand;
-MODULE_SCOPE Tcl_ObjCmdProc NRInterpCoroutine;
+MODULE_SCOPE Tcl_ObjCmdProc TclNRInterpCoroutine;
/*
*----------------------------------------------------------------
@@ -1365,6 +1364,16 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst);
(envPtr->procPtr || envPtr->iPtr->varFramePtr->localCachePtr)
/*
+ * Macros for making it easier to deal with tokens and DStrings.
+ */
+
+#define TclDStringAppendToken(dsPtr, tokenPtr) \
+ Tcl_DStringAppend((dsPtr), (tokenPtr)->start, (tokenPtr)->size)
+#define TclRegisterDStringLiteral(envPtr, dsPtr) \
+ TclRegisterLiteral(envPtr, Tcl_DStringValue(dsPtr), \
+ Tcl_DStringLength(dsPtr), /*flags*/ 0)
+
+/*
* DTrace probe macros (NOPs if DTrace support is not enabled).
*/
diff --git a/generic/tclConfig.c b/generic/tclConfig.c
index b4735e8..dea487a 100644
--- a/generic/tclConfig.c
+++ b/generic/tclConfig.c
@@ -155,7 +155,7 @@ Tcl_RegisterConfig(
*/
Tcl_DStringInit(&cmdName);
- Tcl_DStringAppend(&cmdName, "::", -1);
+ TclDStringAppendLiteral(&cmdName, "::");
Tcl_DStringAppend(&cmdName, pkgName, -1);
/*
@@ -173,7 +173,7 @@ Tcl_RegisterConfig(
}
}
- Tcl_DStringAppend(&cmdName, "::pkgconfig", -1);
+ TclDStringAppendLiteral(&cmdName, "::pkgconfig");
if (Tcl_CreateObjCommand(interp, Tcl_DStringValue(&cmdName),
QueryConfigObjCmd, cdPtr, QueryConfigDelete) == NULL) {
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 49418c9..0fa6661 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -1872,9 +1872,9 @@ LoadTableEncoding(
* Read lines from the encoding until EOF.
*/
- for (Tcl_DStringSetLength(&lineString, 0);
+ for (TclDStringClear(&lineString);
(len = Tcl_Gets(chan, &lineString)) >= 0;
- Tcl_DStringSetLength(&lineString, 0)) {
+ TclDStringClear(&lineString)) {
const unsigned char *p;
int to, from;
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 1e1a901..754e480 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -1425,9 +1425,9 @@ TclMakeEnsemble(
Tcl_DStringInit(&buf);
Tcl_DStringInit(&hiddenBuf);
- Tcl_DStringAppend(&hiddenBuf, "tcl:", -1);
+ TclDStringAppendLiteral(&hiddenBuf, "tcl:");
Tcl_DStringAppend(&hiddenBuf, name, -1);
- Tcl_DStringAppend(&hiddenBuf, ":", -1);
+ TclDStringAppendLiteral(&hiddenBuf, ":");
hiddenLen = Tcl_DStringLength(&hiddenBuf);
if (name[0] == ':' && name[1] == ':') {
/*
@@ -1443,14 +1443,14 @@ TclMakeEnsemble(
* multi-word list differently to a single word.
*/
- Tcl_DStringAppend(&buf, "::tcl", -1);
+ TclDStringAppendLiteral(&buf, "::tcl");
if (Tcl_SplitList(NULL, name, &nameCount, &nameParts) != TCL_OK) {
Tcl_Panic("invalid ensemble name '%s'", name);
}
for (i = 0; i < nameCount; ++i) {
- Tcl_DStringAppend(&buf, "::", 2);
+ TclDStringAppendLiteral(&buf, "::");
Tcl_DStringAppend(&buf, nameParts[i], -1);
}
}
@@ -1485,7 +1485,7 @@ TclMakeEnsemble(
Tcl_Obj *mapDict, *fromObj, *toObj;
Command *cmdPtr;
- Tcl_DStringAppend(&buf, "::", 2);
+ TclDStringAppendLiteral(&buf, "::");
TclNewObj(mapDict);
for (i=0 ; map[i].name != NULL ; i++) {
fromObj = Tcl_NewStringObj(map[i].name, -1);
@@ -1615,10 +1615,10 @@ NsEnsembleImplementationCmdNR(
Tcl_Panic("List of ensemble parameters is not a list");
}
for (; len>0; len--,elemPtrs++) {
- Tcl_DStringAppend(&buf, Tcl_GetString(*elemPtrs), -1);
- Tcl_DStringAppend(&buf, " ", -1);
+ TclDStringAppendObj(&buf, *elemPtrs);
+ TclDStringAppendLiteral(&buf, " ");
}
- Tcl_DStringAppend(&buf, "subcommand ?arg ...?", -1);
+ TclDStringAppendLiteral(&buf, "subcommand ?arg ...?");
Tcl_WrongNumArgs(interp, 1, objv, Tcl_DStringValue(&buf));
Tcl_DStringFree(&buf);
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index e45ae6a..b5ae6ea 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -772,9 +772,9 @@ TclCygwinPutenv(
} else {
int size;
- size = cygwin_posix_to_win32_path_list_buf_size(value);
+ size = cygwin_conv_path_list(0, value, NULL, 0);
buf = alloca(size + 1);
- cygwin_posix_to_win32_path_list(value, buf);
+ cygwin_conv_path_list(0, value, buf, size);
}
SetEnvironmentVariableA(name, buf);
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 48c5454..edb6581 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -72,9 +72,9 @@ SetResultLength(
{
Tcl_DStringSetLength(resultPtr, offset);
if (extended == 2) {
- Tcl_DStringAppend(resultPtr, "//?/UNC/", 8);
+ TclDStringAppendLiteral(resultPtr, "//?/UNC/");
} else if (extended == 1) {
- Tcl_DStringAppend(resultPtr, "//?/", 4);
+ TclDStringAppendLiteral(resultPtr, "//?/");
}
}
@@ -131,7 +131,7 @@ ExtractWinRoot(
if (path[1] != '/' && path[1] != '\\') {
SetResultLength(resultPtr, offset, extended);
*typePtr = TCL_PATH_VOLUME_RELATIVE;
- Tcl_DStringAppend(resultPtr, "/", 1);
+ TclDStringAppendLiteral(resultPtr, "/");
return &path[1];
}
host = &path[2];
@@ -161,7 +161,7 @@ ExtractWinRoot(
*/
*typePtr = TCL_PATH_VOLUME_RELATIVE;
- Tcl_DStringAppend(resultPtr, "/", 1);
+ TclDStringAppendLiteral(resultPtr, "/");
return &path[2];
}
SetResultLength(resultPtr, offset, extended);
@@ -180,9 +180,9 @@ ExtractWinRoot(
break;
}
}
- Tcl_DStringAppend(resultPtr, "//", 2);
+ TclDStringAppendLiteral(resultPtr, "//");
Tcl_DStringAppend(resultPtr, host, hlen);
- Tcl_DStringAppend(resultPtr, "/", 1);
+ TclDStringAppendLiteral(resultPtr, "/");
Tcl_DStringAppend(resultPtr, share, slen);
tail = &share[slen];
@@ -221,7 +221,7 @@ ExtractWinRoot(
*typePtr = TCL_PATH_ABSOLUTE;
Tcl_DStringAppend(resultPtr, path, 2);
- Tcl_DStringAppend(resultPtr, "/", 1);
+ TclDStringAppendLiteral(resultPtr, "/");
return tail;
}
@@ -1057,7 +1057,7 @@ Tcl_TranslateFileName(
}
Tcl_DStringInit(bufferPtr);
- Tcl_DStringAppend(bufferPtr, Tcl_GetString(transPtr), -1);
+ TclDStringAppendObj(bufferPtr, transPtr);
Tcl_DecrRefCount(path);
Tcl_DecrRefCount(transPtr);
@@ -1413,7 +1413,7 @@ Tcl_GlobObjCmd(
search = Tcl_DStringValue(&pref);
while ((find = (strpbrk(search, "\\[]*?{}"))) != NULL) {
Tcl_DStringAppend(&prefix, search, find-search);
- Tcl_DStringAppend(&prefix, "\\", 1);
+ TclDStringAppendLiteral(&prefix, "\\");
Tcl_DStringAppend(&prefix, find, 1);
search = find+1;
if (*search == '\0') {
@@ -1575,8 +1575,7 @@ Tcl_GlobObjCmd(
Tcl_DStringInit(&prefix);
}
for (i = 0; i < objc; i++) {
- string = Tcl_GetStringFromObj(objv[i], &length);
- Tcl_DStringAppend(&prefix, string, length);
+ TclDStringAppendObj(&prefix, objv[i]);
if (i != objc -1) {
Tcl_DStringAppend(&prefix, separators, 1);
}
@@ -1592,11 +1591,9 @@ Tcl_GlobObjCmd(
for (i = 0; i < objc; i++) {
Tcl_DStringInit(&str);
if (dir == PATH_GENERAL) {
- Tcl_DStringAppend(&str, Tcl_DStringValue(&prefix),
- Tcl_DStringLength(&prefix));
+ TclDStringAppendDString(&str, &prefix);
}
- string = Tcl_GetStringFromObj(objv[i], &length);
- Tcl_DStringAppend(&str, string, length);
+ TclDStringAppendObj(&str, objv[i]);
if (TclGlob(interp, Tcl_DStringValue(&str), pathOrDir, globFlags,
globTypes) != TCL_OK) {
result = TCL_ERROR;
@@ -2401,9 +2398,9 @@ DoGlob(
if (length == 0 && (Tcl_DStringLength(&append) == 0)) {
if (((*name == '\\') && (name[1] == '/' ||
name[1] == '\\')) || (*name == '/')) {
- Tcl_DStringAppend(&append, "/", 1);
+ TclDStringAppendLiteral(&append, "/");
} else {
- Tcl_DStringAppend(&append, ".", 1);
+ TclDStringAppendLiteral(&append, ".");
}
}
@@ -2412,9 +2409,9 @@ DoGlob(
case TCL_PLATFORM_UNIX:
if (length == 0 && (Tcl_DStringLength(&append) == 0)) {
if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
- Tcl_DStringAppend(&append, "/", 1);
+ TclDStringAppendLiteral(&append, "/");
} else {
- Tcl_DStringAppend(&append, ".", 1);
+ TclDStringAppendLiteral(&append, ".");
}
}
break;
diff --git a/generic/tclFileSystem.h b/generic/tclFileSystem.h
index 088bf85..6be3e03 100644
--- a/generic/tclFileSystem.h
+++ b/generic/tclFileSystem.h
@@ -16,44 +16,6 @@
#include "tcl.h"
/*
- * struct FilesystemRecord --
- *
- * A filesystem record is used to keep track of each filesystem currently
- * registered with the core, in a linked list. Pointers to these structures
- * are also kept by each "path" Tcl_Obj, and we must retain a refCount on the
- * number of such references.
- */
-
-typedef struct FilesystemRecord {
- ClientData clientData; /* Client specific data for the new filesystem
- * (can be NULL) */
- const Tcl_Filesystem *fsPtr; /* Pointer to filesystem dispatch table. */
- struct FilesystemRecord *nextPtr;
- /* The next filesystem registered to Tcl, or
- * NULL if no more. */
- struct FilesystemRecord *prevPtr;
- /* The previous filesystem registered to Tcl,
- * or NULL if no more. */
-} FilesystemRecord;
-
-/*
- * This structure holds per-thread private copy of the current directory
- * maintained by the global cwdPathPtr. This structure holds per-thread
- * private copies of some global data. This way we avoid most of the
- * synchronization calls which boosts performance, at cost of having to update
- * this information each time the corresponding epoch counter changes.
- */
-
-typedef struct ThreadSpecificData {
- int initialized;
- int cwdPathEpoch;
- int filesystemEpoch;
- Tcl_Obj *cwdPathPtr;
- ClientData cwdClientData;
- FilesystemRecord *filesystemList;
-} ThreadSpecificData;
-
-/*
* The internal TclFS API provides routines for handling and manipulating
* paths efficiently, taking direct advantage of the "path" Tcl_Obj type.
*
@@ -61,8 +23,6 @@ typedef struct ThreadSpecificData {
*/
MODULE_SCOPE int TclFSCwdPointerEquals(Tcl_Obj **pathPtrPtr);
-MODULE_SCOPE int TclFSMakePathFromNormalized(Tcl_Interp *interp,
- Tcl_Obj *pathPtr);
MODULE_SCOPE int TclFSNormalizeToUniquePath(Tcl_Interp *interp,
Tcl_Obj *pathPtr, int startAt);
MODULE_SCOPE Tcl_Obj * TclFSMakePathRelative(Tcl_Interp *interp,
@@ -73,13 +33,13 @@ MODULE_SCOPE void TclFSSetPathDetails(Tcl_Obj *pathPtr,
const Tcl_Filesystem *fsPtr, ClientData clientData);
MODULE_SCOPE Tcl_Obj * TclFSNormalizeAbsolutePath(Tcl_Interp *interp,
Tcl_Obj *pathPtr);
+MODULE_SCOPE int TclFSEpoch(void);
/*
* Private shared variables for use by tclIOUtil.c and tclPathObj.c
*/
MODULE_SCOPE const Tcl_Filesystem tclNativeFilesystem;
-MODULE_SCOPE Tcl_ThreadDataKey tclFsDataKey;
/*
* Private shared functions for use by tclIOUtil.c, tclPathObj.c and
diff --git a/generic/tclIO.c b/generic/tclIO.c
index a76aba3..ea6c2d7 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -4431,14 +4431,12 @@ Tcl_Gets(
* for managing the storage. */
{
Tcl_Obj *objPtr;
- int charsStored, length;
- const char *string;
+ int charsStored;
TclNewObj(objPtr);
charsStored = Tcl_GetsObj(chan, objPtr);
if (charsStored > 0) {
- string = TclGetStringFromObj(objPtr, &length);
- Tcl_DStringAppend(lineRead, string, length);
+ TclDStringAppendObj(lineRead, objPtr);
}
TclDecrRefCount(objPtr);
return charsStored;
@@ -7550,7 +7548,7 @@ Tcl_BadChannelOption(
Tcl_DStringInit(&ds);
Tcl_DStringAppend(&ds, genericopt, -1);
if (optionList && (*optionList)) {
- Tcl_DStringAppend(&ds, " ", 1);
+ TclDStringAppendLiteral(&ds, " ");
Tcl_DStringAppend(&ds, optionList, -1);
}
if (Tcl_SplitList(interp, Tcl_DStringValue(&ds),
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 938def2..6fec40a 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -1947,7 +1947,7 @@ ReflectGetOption(
*/
if (optionObj != NULL) {
- Tcl_DStringAppend(dsPtr, TclGetString(resObj), -1);
+ TclDStringAppendObj(dsPtr, resObj);
goto ok;
}
@@ -1982,7 +1982,7 @@ ReflectGetOption(
const char *str = Tcl_GetStringFromObj(resObj, &len);
if (len) {
- Tcl_DStringAppend(dsPtr, " ", 1);
+ TclDStringAppendLiteral(dsPtr, " ");
Tcl_DStringAppend(dsPtr, str, len);
}
goto ok;
@@ -3207,8 +3207,7 @@ ForwardProc(
if (InvokeTclMethod(rcPtr, "cget", optionObj, NULL, &resObj)!=TCL_OK){
ForwardSetObjError(paramPtr, resObj);
} else {
- Tcl_DStringAppend(paramPtr->getOpt.value,
- TclGetString(resObj), -1);
+ TclDStringAppendObj(paramPtr->getOpt.value, resObj);
}
Tcl_Release(rcPtr);
Tcl_DecrRefCount(optionObj);
@@ -3233,7 +3232,7 @@ ForwardProc(
Tcl_Obj **listv;
if (Tcl_ListObjGetElements(interp, resObj, &listc,
- &listv) != TCL_OK) {
+ &listv) != TCL_OK) {
Tcl_DecrRefCount(resObj);
resObj = MarshallError(interp);
ForwardSetObjError(paramPtr, resObj);
@@ -3253,7 +3252,7 @@ ForwardProc(
const char *str = Tcl_GetStringFromObj(resObj, &len);
if (len) {
- Tcl_DStringAppend(paramPtr->getOpt.value, " ", 1);
+ TclDStringAppendLiteral(paramPtr->getOpt.value, " ");
Tcl_DStringAppend(paramPtr->getOpt.value, str, len);
}
}
diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c
index 6a7be7e..018f9f5 100644
--- a/generic/tclIOSock.c
+++ b/generic/tclIOSock.c
@@ -100,16 +100,16 @@ TclSockMinimumBuffers(
socklen_t len;
len = sizeof(int);
- getsockopt((SOCKET)sock, SOL_SOCKET, SO_SNDBUF, (char *)&current, &len);
+ getsockopt((SOCKET)(size_t)sock, SOL_SOCKET, SO_SNDBUF, (char *)&current, &len);
if (current < size) {
len = sizeof(int);
- setsockopt((SOCKET)sock, SOL_SOCKET, SO_SNDBUF, (char *)&size, len);
+ setsockopt((SOCKET)(size_t)sock, SOL_SOCKET, SO_SNDBUF, (char *)&size, len);
}
len = sizeof(int);
- getsockopt((SOCKET)sock, SOL_SOCKET, SO_RCVBUF, (char *)&current, &len);
+ getsockopt((SOCKET)(size_t)sock, SOL_SOCKET, SO_RCVBUF, (char *)&current, &len);
if (current < size) {
len = sizeof(int);
- setsockopt((SOCKET)sock, SOL_SOCKET, SO_RCVBUF, (char *)&size, len);
+ setsockopt((SOCKET)(size_t)sock, SOL_SOCKET, SO_RCVBUF, (char *)&size, len);
}
return TCL_OK;
}
@@ -206,9 +206,12 @@ TclCreateSocketAddress(
}
if (result != 0) {
- if (result != EAI_SYSTEM) {
+#ifdef EAI_SYSTEM /* Doesn't exist on Windows */
+ if (result == EAI_SYSTEM)
+ *errorMsgPtr = Tcl_PosixError(interp);
+ else
+#endif
*errorMsgPtr = gai_strerror(result);
- }
return 0;
}
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index b8bb0f7..41a5aac 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -28,6 +28,43 @@
#include "tclFileSystem.h"
/*
+ * struct FilesystemRecord --
+ *
+ * A filesystem record is used to keep track of each filesystem currently
+ * registered with the core, in a linked list.
+ */
+
+typedef struct FilesystemRecord {
+ ClientData clientData; /* Client specific data for the new filesystem
+ * (can be NULL) */
+ const Tcl_Filesystem *fsPtr;/* Pointer to filesystem dispatch table. */
+ struct FilesystemRecord *nextPtr;
+ /* The next filesystem registered to Tcl, or
+ * NULL if no more. */
+ struct FilesystemRecord *prevPtr;
+ /* The previous filesystem registered to Tcl,
+ * or NULL if no more. */
+} FilesystemRecord;
+
+/*
+ * This structure holds per-thread private copy of the current directory
+ * maintained by the global cwdPathPtr. This structure holds per-thread
+ * private copies of some global data. This way we avoid most of the
+ * synchronization calls which boosts performance, at cost of having to update
+ * this information each time the corresponding epoch counter changes.
+ */
+
+typedef struct ThreadSpecificData {
+ int initialized;
+ int cwdPathEpoch;
+ int filesystemEpoch;
+ Tcl_Obj *cwdPathPtr;
+ ClientData cwdClientData;
+ FilesystemRecord *filesystemList;
+ int claims;
+} ThreadSpecificData;
+
+/*
* Prototypes for functions defined later in this file.
*/
@@ -40,9 +77,10 @@ static void FsAddMountsToGlobResult(Tcl_Obj *resultPtr,
Tcl_Obj *pathPtr, const char *pattern,
Tcl_GlobTypeData *types);
static void FsUpdateCwd(Tcl_Obj *cwdObj, ClientData clientData);
-#ifdef TCL_THREADS
static void FsRecacheFilesystemList(void);
-#endif
+static void Claim(void);
+static void Disclaim(void);
+
static void * DivertFindSymbol(Tcl_Interp *interp,
Tcl_LoadHandle loadHandle, const char *symbol);
static void DivertUnloadFile(Tcl_LoadHandle loadHandle);
@@ -174,7 +212,7 @@ static FilesystemRecord nativeFilesystemRecord = {
* trigger cache cleanup in all threads.
*/
-static int theFilesystemEpoch = 0;
+static int theFilesystemEpoch = 1;
/*
* Stores the linked list of filesystems. A 1:1 copy of this list is also
@@ -194,7 +232,7 @@ static int cwdPathEpoch = 0;
static ClientData cwdClientData = NULL;
TCL_DECLARE_MUTEX(cwdMutex)
-Tcl_ThreadDataKey tclFsDataKey;
+static Tcl_ThreadDataKey fsDataKey;
/*
* One of these structures is used each time we successfully load a file from
@@ -367,7 +405,7 @@ Tcl_GetCwd(
return NULL;
}
Tcl_DStringInit(cwdPtr);
- Tcl_DStringAppend(cwdPtr, Tcl_GetString(cwd), -1);
+ TclDStringAppendObj(cwdPtr, cwd);
Tcl_DecrRefCount(cwd);
return Tcl_DStringValue(cwdPtr);
}
@@ -428,7 +466,7 @@ FsThrExitProc(
int
TclFSCwdIsNative(void)
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
if (tsdPtr->cwdClientData != NULL) {
return 1;
@@ -462,7 +500,7 @@ int
TclFSCwdPointerEquals(
Tcl_Obj **pathPtrPtr)
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
Tcl_MutexLock(&cwdMutex);
if (tsdPtr->cwdPathPtr == NULL
@@ -521,12 +559,11 @@ TclFSCwdPointerEquals(
}
}
-#ifdef TCL_THREADS
static void
FsRecacheFilesystemList(void)
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
- FilesystemRecord *fsRecPtr, *tmpFsRecPtr = NULL, *toFree = NULL;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
+ FilesystemRecord *fsRecPtr, *tmpFsRecPtr = NULL, *toFree = NULL, *list;
/*
* Trash the current cache.
@@ -535,20 +572,16 @@ FsRecacheFilesystemList(void)
fsRecPtr = tsdPtr->filesystemList;
while (fsRecPtr != NULL) {
tmpFsRecPtr = fsRecPtr->nextPtr;
- fsRecPtr->fsPtr = NULL;
fsRecPtr->nextPtr = toFree;
toFree = fsRecPtr;
fsRecPtr = tmpFsRecPtr;
}
- tsdPtr->filesystemList = NULL;
/*
- * Code below operates on shared data. We are already called under mutex
- * lock so we can safely proceed.
- *
* Locate tail of the global filesystem list.
*/
+ Tcl_MutexLock(&filesystemMutex);
fsRecPtr = filesystemList;
while (fsRecPtr != NULL) {
tmpFsRecPtr = fsRecPtr;
@@ -559,21 +592,23 @@ FsRecacheFilesystemList(void)
* Refill the cache honouring the order.
*/
+ list = NULL;
fsRecPtr = tmpFsRecPtr;
while (fsRecPtr != NULL) {
tmpFsRecPtr = ckalloc(sizeof(FilesystemRecord));
*tmpFsRecPtr = *fsRecPtr;
- tmpFsRecPtr->nextPtr = tsdPtr->filesystemList;
+ tmpFsRecPtr->nextPtr = list;
tmpFsRecPtr->prevPtr = NULL;
- if (tsdPtr->filesystemList) {
- tsdPtr->filesystemList->prevPtr = tmpFsRecPtr;
- }
- tsdPtr->filesystemList = tmpFsRecPtr;
+ list = tmpFsRecPtr;
fsRecPtr = fsRecPtr->prevPtr;
}
+ tsdPtr->filesystemList = list;
+ tsdPtr->filesystemEpoch = theFilesystemEpoch;
+ Tcl_MutexUnlock(&filesystemMutex);
while (toFree) {
FilesystemRecord *next = toFree->nextPtr;
+ toFree->fsPtr = NULL;
ckfree(toFree);
toFree = next;
}
@@ -587,28 +622,16 @@ FsRecacheFilesystemList(void)
tsdPtr->initialized = 1;
}
}
-#endif /* TCL_THREADS */
static FilesystemRecord *
FsGetFirstFilesystem(void)
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
- FilesystemRecord *fsRecPtr;
-
-#ifndef TCL_THREADS
- tsdPtr->filesystemEpoch = theFilesystemEpoch;
- fsRecPtr = filesystemList;
-#else
- Tcl_MutexLock(&filesystemMutex);
- if (tsdPtr->filesystemList == NULL
- || (tsdPtr->filesystemEpoch != theFilesystemEpoch)) {
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
+ if (tsdPtr->filesystemList == NULL || ((tsdPtr->claims == 0)
+ && (tsdPtr->filesystemEpoch != theFilesystemEpoch))) {
FsRecacheFilesystemList();
- tsdPtr->filesystemEpoch = theFilesystemEpoch;
}
- Tcl_MutexUnlock(&filesystemMutex);
- fsRecPtr = tsdPtr->filesystemList;
-#endif
- return fsRecPtr;
+ return tsdPtr->filesystemList;
}
/*
@@ -620,11 +643,30 @@ int
TclFSEpochOk(
int filesystemEpoch)
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+ return (filesystemEpoch == 0 || filesystemEpoch == theFilesystemEpoch);
+}
+
+static void
+Claim()
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
+ tsdPtr->claims++;
+}
+
+static void
+Disclaim()
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
+ tsdPtr->claims--;
+}
- (void) FsGetFirstFilesystem();
- return (filesystemEpoch == tsdPtr->filesystemEpoch);
+int
+TclFSEpoch()
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
+ return tsdPtr->filesystemEpoch;
}
+
/*
* If non-NULL, clientData is owned by us and must be freed later.
@@ -637,7 +679,7 @@ FsUpdateCwd(
{
int len;
const char *str = NULL;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
if (cwdObj != NULL) {
str = Tcl_GetStringFromObj(cwdObj, &len);
@@ -741,6 +783,7 @@ TclFinalizeFilesystem(void)
}
fsRecPtr = tmpFsRecPtr;
}
+ theFilesystemEpoch++;
filesystemList = NULL;
/*
@@ -773,6 +816,7 @@ void
TclResetFilesystem(void)
{
filesystemList = &nativeFilesystemRecord;
+ theFilesystemEpoch++;
#ifdef __WIN32__
/*
@@ -1345,6 +1389,7 @@ TclFSNormalizeToUniquePath(
firstFsRecPtr = FsGetFirstFilesystem();
+ Claim();
for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
continue;
@@ -1382,6 +1427,7 @@ TclFSNormalizeToUniquePath(
* but there's not much benefit.
*/
}
+ Disclaim();
return startAt;
}
@@ -2576,7 +2622,7 @@ Tcl_Obj *
Tcl_FSGetCwd(
Tcl_Interp *interp)
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
if (TclFSCwdPointerEquals(NULL)) {
FilesystemRecord *fsRecPtr;
@@ -2588,8 +2634,9 @@ Tcl_FSGetCwd(
* indicates the particular function has succeeded.
*/
- for (fsRecPtr = FsGetFirstFilesystem();
- (retVal == NULL) && (fsRecPtr != NULL);
+ fsRecPtr = FsGetFirstFilesystem();
+ Claim();
+ for (; (retVal == NULL) && (fsRecPtr != NULL);
fsRecPtr = fsRecPtr->nextPtr) {
ClientData retCd;
TclFSGetCwdProc2 *proc2;
@@ -2634,6 +2681,7 @@ Tcl_FSGetCwd(
}
Tcl_DecrRefCount(retVal);
retVal = NULL;
+ Disclaim();
goto cdDidNotChange;
} else if (interp != NULL) {
Tcl_AppendResult(interp,
@@ -2641,6 +2689,7 @@ Tcl_FSGetCwd(
Tcl_PosixError(interp), NULL);
}
}
+ Disclaim();
/*
* Now the 'cwd' may NOT be normalized, at least on some platforms.
@@ -2924,7 +2973,7 @@ Tcl_FSChdir(
* instead. This should be examined by someone on Unix.
*/
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
ClientData cd;
ClientData oldcd = tsdPtr->cwdClientData;
@@ -3761,6 +3810,7 @@ Tcl_FSListVolumes(void)
*/
fsRecPtr = FsGetFirstFilesystem();
+ Claim();
while (fsRecPtr != NULL) {
if (fsRecPtr->fsPtr->listVolumesProc != NULL) {
Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc();
@@ -3772,6 +3822,7 @@ Tcl_FSListVolumes(void)
}
fsRecPtr = fsRecPtr->nextPtr;
}
+ Disclaim();
return resultPtr;
}
@@ -3811,6 +3862,7 @@ FsListMounts(
*/
fsRecPtr = FsGetFirstFilesystem();
+ Claim();
while (fsRecPtr != NULL) {
if (fsRecPtr->fsPtr != &tclNativeFilesystem &&
fsRecPtr->fsPtr->matchInDirectoryProc != NULL) {
@@ -3822,6 +3874,7 @@ FsListMounts(
}
fsRecPtr = fsRecPtr->nextPtr;
}
+ Disclaim();
return resultPtr;
}
@@ -4034,6 +4087,7 @@ TclFSNonnativePathType(
*/
fsRecPtr = FsGetFirstFilesystem();
+ Claim();
while (fsRecPtr != NULL) {
/*
* We want to skip the native filesystem in this loop because
@@ -4111,6 +4165,7 @@ TclFSNonnativePathType(
}
fsRecPtr = fsRecPtr->nextPtr;
}
+ Disclaim();
return type;
}
@@ -4498,10 +4553,14 @@ Tcl_FSGetFileSystemForPath(
*/
fsRecPtr = FsGetFirstFilesystem();
+ Claim();
+
if (TclFSEnsureEpochOk(pathPtr, &retVal) != TCL_OK) {
+ Disclaim();
return NULL;
} else if (retVal != NULL) {
/* TODO: Can this happen? */
+ Disclaim();
return retVal;
}
@@ -4524,9 +4583,11 @@ Tcl_FSGetFileSystemForPath(
*/
TclFSSetPathDetails(pathPtr, fsRecPtr->fsPtr, clientData);
+ Disclaim();
return fsRecPtr->fsPtr;
}
}
+ Disclaim();
return NULL;
}
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index 97517ea..9f73a31 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -1095,6 +1095,11 @@ declare 16 win {
# declare 17 win {
# char *TclpGetTZName(void)
# }
+# new for 8.5.12+ Cygwin only
+declare 17 win {
+ int TclUnixCopyFile(const char *src, const char *dst,
+ const Tcl_StatBuf *statBufPtr, int dontCopyAtts)
+}
declare 18 win {
TclFile TclpMakeFile(Tcl_Channel channel, int direction)
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 9068dfb..53a88d6 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2920,6 +2920,10 @@ MODULE_SCOPE void TclCreateLateExitHandler(Tcl_ExitProc *proc,
ClientData clientData);
MODULE_SCOPE void TclDeleteLateExitHandler(Tcl_ExitProc *proc,
ClientData clientData);
+MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr,
+ Tcl_Obj *objPtr);
+MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr,
+ Tcl_DString *toAppendPtr);
MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr);
MODULE_SCOPE void TclFinalizeAllocSubsystem(void);
MODULE_SCOPE void TclFinalizeAsync(void);
@@ -4452,6 +4456,21 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
/*
*----------------------------------------------------------------
+ * Convenience macros for DStrings.
+ * The ANSI C "prototypes" for these macros are:
+ *
+ * MODULE_SCOPE char * TclDStringAppendLiteral(Tcl_DString *dsPtr,
+ * const char *sLiteral);
+ * MODULE_SCOPE void TclDStringClear(Tcl_DString *dsPtr);
+ */
+
+#define TclDStringAppendLiteral(dsPtr, sLiteral) \
+ Tcl_DStringAppend((dsPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1))
+#define TclDStringClear(dsPtr) \
+ Tcl_DStringSetLength((dsPtr), 0)
+
+/*
+ *----------------------------------------------------------------
* Macros used by the Tcl core to test for some special double values.
* The ANSI C "prototypes" for these macros are:
*
diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
index a9c6e8c..7322a37 100644
--- a/generic/tclIntPlatDecls.h
+++ b/generic/tclIntPlatDecls.h
@@ -140,7 +140,10 @@ EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc,
Tcl_Pid *pidPtr);
/* 16 */
EXTERN int TclpIsAtty(int fd);
-/* Slot 17 is reserved */
+/* 17 */
+EXTERN int TclUnixCopyFile(const char *src, const char *dst,
+ const Tcl_StatBuf *statBufPtr,
+ int dontCopyAtts);
/* 18 */
EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction);
/* 19 */
@@ -289,7 +292,7 @@ typedef struct TclIntPlatStubs {
int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 14 */
int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */
int (*tclpIsAtty) (int fd); /* 16 */
- void (*reserved17)(void);
+ int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */
TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */
void (*tclWinAddProcess) (HANDLE hProcess, DWORD id); /* 20 */
@@ -433,7 +436,8 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
(tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */
#define TclpIsAtty \
(tclIntPlatStubsPtr->tclpIsAtty) /* 16 */
-/* Slot 17 is reserved */
+#define TclUnixCopyFile \
+ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 17 */
#define TclpMakeFile \
(tclIntPlatStubsPtr->tclpMakeFile) /* 18 */
#define TclpOpenFile \
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index 008a99d..ce4d6a4 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -198,9 +198,9 @@ Tcl_LoadObjCmd(
if (packageName == NULL) {
namesMatch = 0;
} else {
- Tcl_DStringSetLength(&pkgName, 0);
+ TclDStringClear(&pkgName);
Tcl_DStringAppend(&pkgName, packageName, -1);
- Tcl_DStringSetLength(&tmp, 0);
+ TclDStringClear(&tmp);
Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
Tcl_UtfToLower(Tcl_DStringValue(&pkgName));
Tcl_UtfToLower(Tcl_DStringValue(&tmp));
@@ -211,7 +211,7 @@ Tcl_LoadObjCmd(
namesMatch = 0;
}
}
- Tcl_DStringSetLength(&pkgName, 0);
+ TclDStringClear(&pkgName);
filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
if (filesMatch && (namesMatch || (packageName == NULL))) {
@@ -329,7 +329,7 @@ Tcl_LoadObjCmd(
code = TCL_ERROR;
goto done;
}
- Tcl_DStringAppend(&pkgName, pkgGuess, (p - pkgGuess));
+ Tcl_DStringAppend(&pkgName, pkgGuess, p - pkgGuess);
Tcl_DecrRefCount(splitPtr);
}
}
@@ -348,14 +348,14 @@ Tcl_LoadObjCmd(
* package name.
*/
- Tcl_DStringAppend(&initName, Tcl_DStringValue(&pkgName), -1);
- Tcl_DStringAppend(&initName, "_Init", 5);
- Tcl_DStringAppend(&safeInitName, Tcl_DStringValue(&pkgName), -1);
- Tcl_DStringAppend(&safeInitName, "_SafeInit", 9);
- Tcl_DStringAppend(&unloadName, Tcl_DStringValue(&pkgName), -1);
- Tcl_DStringAppend(&unloadName, "_Unload", 7);
- Tcl_DStringAppend(&safeUnloadName, Tcl_DStringValue(&pkgName), -1);
- Tcl_DStringAppend(&safeUnloadName, "_SafeUnload", 11);
+ TclDStringAppendDString(&initName, &pkgName);
+ TclDStringAppendLiteral(&initName, "_Init");
+ TclDStringAppendDString(&safeInitName, &pkgName);
+ TclDStringAppendLiteral(&safeInitName, "_SafeInit");
+ TclDStringAppendDString(&unloadName, &pkgName);
+ TclDStringAppendLiteral(&unloadName, "_Unload");
+ TclDStringAppendDString(&safeUnloadName, &pkgName);
+ TclDStringAppendLiteral(&safeUnloadName, "_SafeUnload");
/*
* Call platform-specific code to load the package and find the two
@@ -623,9 +623,9 @@ Tcl_UnloadObjCmd(
if (packageName == NULL) {
namesMatch = 0;
} else {
- Tcl_DStringSetLength(&pkgName, 0);
+ TclDStringClear(&pkgName);
Tcl_DStringAppend(&pkgName, packageName, -1);
- Tcl_DStringSetLength(&tmp, 0);
+ TclDStringClear(&tmp);
Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
Tcl_UtfToLower(Tcl_DStringValue(&pkgName));
Tcl_UtfToLower(Tcl_DStringValue(&tmp));
@@ -636,7 +636,7 @@ Tcl_UnloadObjCmd(
namesMatch = 0;
}
}
- Tcl_DStringSetLength(&pkgName, 0);
+ TclDStringClear(&pkgName);
filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
if (filesMatch && (namesMatch || (packageName == NULL))) {
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 73bc644..6a241f0 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -24,7 +24,7 @@
*/
#include "tclInt.h"
-#include "tclCompile.h" /* for NRCommand; and TclLogCommandInfo visibility */
+#include "tclCompile.h" /* for TclLogCommandInfo visibility */
/*
* Thread-local storage used to avoid having a global lock on data that is not
@@ -803,10 +803,9 @@ Tcl_CreateNamespace(
if (ancestorPtr != globalNsPtr) {
register Tcl_DString *tempPtr = namePtr;
- Tcl_DStringAppend(buffPtr, "::", 2);
+ TclDStringAppendLiteral(buffPtr, "::");
Tcl_DStringAppend(buffPtr, ancestorPtr->name, -1);
- Tcl_DStringAppend(buffPtr, Tcl_DStringValue(namePtr),
- Tcl_DStringLength(namePtr));
+ TclDStringAppendDString(buffPtr, namePtr);
/*
* Clear the unwanted buffer or we end up appending to previous
@@ -814,7 +813,7 @@ Tcl_CreateNamespace(
* very wrong (and strange).
*/
- Tcl_DStringSetLength(namePtr, 0);
+ TclDStringClear(namePtr);
/*
* Now swap the buffer pointers so that we build in the other
@@ -916,7 +915,7 @@ Tcl_DeleteNamespace(
for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
entryPtr != NULL;) {
cmdPtr = Tcl_GetHashValue(entryPtr);
- if (cmdPtr->nreProc == NRInterpCoroutine) {
+ if (cmdPtr->nreProc == TclNRInterpCoroutine) {
Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr,
(Tcl_Command) cmdPtr);
entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
@@ -1667,7 +1666,7 @@ DoImport(
Tcl_DStringInit(&ds);
Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
if (nsPtr != ((Interp *) interp)->globalNsPtr) {
- Tcl_DStringAppend(&ds, "::", 2);
+ TclDStringAppendLiteral(&ds, "::");
}
Tcl_DStringAppend(&ds, cmdName, -1);
@@ -2241,7 +2240,7 @@ TclGetNamespaceForQualName(
* qualName since it may be a string constant.
*/
- Tcl_DStringSetLength(&buffer, 0);
+ TclDStringClear(&buffer);
Tcl_DStringAppend(&buffer, start, len);
nsName = Tcl_DStringValue(&buffer);
}
@@ -2916,7 +2915,7 @@ NamespaceChildrenCmd(
} else {
Tcl_DStringAppend(&buffer, nsPtr->fullName, -1);
if (nsPtr != globalNsPtr) {
- Tcl_DStringAppend(&buffer, "::", 2);
+ TclDStringAppendLiteral(&buffer, "::");
}
Tcl_DStringAppend(&buffer, name, -1);
pattern = Tcl_DStringValue(&buffer);
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 26e6d75..821befd 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -356,14 +356,14 @@ InitFoundation(
Tcl_DStringInit(&buffer);
for (i=0 ; defineCmds[i].name ; i++) {
- Tcl_DStringAppend(&buffer, "::oo::define::", 14);
+ TclDStringAppendLiteral(&buffer, "::oo::define::");
Tcl_DStringAppend(&buffer, defineCmds[i].name, -1);
Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
defineCmds[i].objProc, INT2PTR(defineCmds[i].flag), NULL);
Tcl_DStringFree(&buffer);
}
for (i=0 ; objdefCmds[i].name ; i++) {
- Tcl_DStringAppend(&buffer, "::oo::objdefine::", 17);
+ TclDStringAppendLiteral(&buffer, "::oo::objdefine::");
Tcl_DStringAppend(&buffer, objdefCmds[i].name, -1);
Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
objdefCmds[i].objProc, INT2PTR(objdefCmds[i].flag), NULL);
@@ -657,7 +657,7 @@ AllocObject(
Tcl_DStringInit(&buffer);
Tcl_DStringAppend(&buffer,
Tcl_GetCurrentNamespace(interp)->fullName, -1);
- Tcl_DStringAppend(&buffer, "::", 2);
+ TclDStringAppendLiteral(&buffer, "::");
Tcl_DStringAppend(&buffer, nameStr, -1);
oPtr->command = Tcl_CreateObjCommand(interp,
Tcl_DStringValue(&buffer), PublicObjectCmd, oPtr, NULL);
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
index 5e983fc..35ad1eb 100644
--- a/generic/tclOOBasic.c
+++ b/generic/tclOOBasic.c
@@ -1190,7 +1190,7 @@ TclOOCopyObjectCmd(
Tcl_DStringAppend(&buffer,
iPtr->varFramePtr->nsPtr->fullName, -1);
}
- Tcl_DStringAppend(&buffer, "::", 2);
+ TclDStringAppendLiteral(&buffer, "::");
Tcl_DStringAppend(&buffer, name, -1);
name = Tcl_DStringValue(&buffer);
}
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 06ee984..8bae4fb 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -27,6 +27,8 @@ static int SetFsPathFromAny(Tcl_Interp *interp, Tcl_Obj *pathPtr);
static int FindSplitPos(const char *path, int separator);
static int IsSeparatorOrNull(int ch);
static Tcl_Obj * GetExtension(Tcl_Obj *pathPtr);
+static int MakePathFromNormalized(Tcl_Interp *interp,
+ Tcl_Obj *pathPtr);
/*
* Define the 'path' object type, which Tcl uses to represent file paths
@@ -432,7 +434,7 @@ TclFSNormalizeAbsolutePath(
* object into an FsPath for greater efficiency
*/
- TclFSMakePathFromNormalized(interp, retVal);
+ MakePathFromNormalized(interp, retVal);
/*
* This has a refCount of 1 for the caller, unlike many Tcl_Obj APIs.
@@ -564,8 +566,7 @@ TclPathPart(
if (pathPtr->typePtr == &tclFsPathType) {
FsPath *fsPathPtr = PATHOBJ(pathPtr);
- if (TclFSEpochOk(fsPathPtr->filesystemEpoch)
- && (PATHFLAGS(pathPtr) != 0)) {
+ if (PATHFLAGS(pathPtr) != 0) {
switch (portion) {
case TCL_PATH_DIRNAME: {
/*
@@ -1263,7 +1264,6 @@ TclNewFSPathObj(
{
FsPath *fsPathPtr;
Tcl_Obj *pathPtr;
- ThreadSpecificData *tsdPtr;
const char *p;
int state = 0, count = 0;
@@ -1291,8 +1291,6 @@ TclNewFSPathObj(
return pathPtr;
}
- tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
-
pathPtr = Tcl_NewObj();
fsPathPtr = ckalloc(sizeof(FsPath));
@@ -1307,7 +1305,7 @@ TclNewFSPathObj(
Tcl_IncrRefCount(dirPtr);
fsPathPtr->nativePathPtr = NULL;
fsPathPtr->fsPtr = NULL;
- fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
+ fsPathPtr->filesystemEpoch = 0;
SETPATHOBJ(pathPtr, fsPathPtr);
PATHFLAGS(pathPtr) = TCLPATH_APPENDED;
@@ -1461,7 +1459,7 @@ TclFSMakePathRelative(
/*
*---------------------------------------------------------------------------
*
- * TclFSMakePathFromNormalized --
+ * MakePathFromNormalized --
*
* Like SetFsPathFromAny, but assumes the given object is an absolute
* normalized path. Only for internal use.
@@ -1475,13 +1473,12 @@ TclFSMakePathRelative(
*---------------------------------------------------------------------------
*/
-int
-TclFSMakePathFromNormalized(
+static int
+MakePathFromNormalized(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
Tcl_Obj *pathPtr) /* The object to convert. */
{
FsPath *fsPathPtr;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
if (pathPtr->typePtr == &tclFsPathType) {
return TCL_OK;
@@ -1524,7 +1521,8 @@ TclFSMakePathFromNormalized(
fsPathPtr->cwdPtr = NULL;
fsPathPtr->nativePathPtr = NULL;
fsPathPtr->fsPtr = NULL;
- fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
+ /* Remember the epoch under which we decided pathPtr was normalized */
+ fsPathPtr->filesystemEpoch = TclFSEpoch();
SETPATHOBJ(pathPtr, fsPathPtr);
PATHFLAGS(pathPtr) = 0;
@@ -1566,7 +1564,6 @@ Tcl_FSNewNativePath(
Tcl_Obj *pathPtr = NULL;
FsPath *fsPathPtr;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
if (fromFilesystem->internalToNormalizedProc != NULL) {
pathPtr = (*fromFilesystem->internalToNormalizedProc)(clientData);
@@ -1602,7 +1599,7 @@ Tcl_FSNewNativePath(
fsPathPtr->cwdPtr = NULL;
fsPathPtr->nativePathPtr = clientData;
fsPathPtr->fsPtr = fromFilesystem;
- fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
+ fsPathPtr->filesystemEpoch = TclFSEpoch();
SETPATHOBJ(pathPtr, fsPathPtr);
PATHFLAGS(pathPtr) = 0;
@@ -1660,6 +1657,12 @@ Tcl_FSGetTranslatedPath(
retObj = Tcl_FSJoinToPath(translatedCwdPtr, 1,
&srcFsPathPtr->normPathPtr);
srcFsPathPtr->translatedPathPtr = retObj;
+ if (translatedCwdPtr->typePtr == &tclFsPathType) {
+ srcFsPathPtr->filesystemEpoch
+ = PATHOBJ(translatedCwdPtr)->filesystemEpoch;
+ } else {
+ srcFsPathPtr->filesystemEpoch = 0;
+ }
Tcl_IncrRefCount(retObj);
Tcl_DecrRefCount(translatedCwdPtr);
} else {
@@ -2203,7 +2206,6 @@ TclFSSetPathDetails(
const Tcl_Filesystem *fsPtr,
ClientData clientData)
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
FsPath *srcFsPathPtr;
/*
@@ -2219,7 +2221,7 @@ TclFSSetPathDetails(
srcFsPathPtr = PATHOBJ(pathPtr);
srcFsPathPtr->fsPtr = fsPtr;
srcFsPathPtr->nativePathPtr = clientData;
- srcFsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
+ srcFsPathPtr->filesystemEpoch = TclFSEpoch();
}
/*
@@ -2308,7 +2310,6 @@ SetFsPathFromAny(
FsPath *fsPathPtr;
Tcl_Obj *transPtr;
char *name;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
if (pathPtr->typePtr == &tclFsPathType) {
return TCL_OK;
@@ -2462,12 +2463,15 @@ SetFsPathFromAny(
fsPathPtr->translatedPathPtr = transPtr;
if (transPtr != pathPtr) {
Tcl_IncrRefCount(fsPathPtr->translatedPathPtr);
+ /* Redo translation when $env(HOME) changes */
+ fsPathPtr->filesystemEpoch = TclFSEpoch();
+ } else {
+ fsPathPtr->filesystemEpoch = 0;
}
fsPathPtr->normPathPtr = NULL;
fsPathPtr->cwdPtr = NULL;
fsPathPtr->nativePathPtr = NULL;
fsPathPtr->fsPtr = NULL;
- fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
/*
* Free old representation before installing our new one.
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index fdaea57..382ffe3 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -1712,11 +1712,11 @@ AddRequirementsToDString(
int i;
for (i = 0; i < reqc; i++) {
- Tcl_DStringAppend(dsPtr, " ", 1);
- Tcl_DStringAppend(dsPtr, TclGetString(reqv[i]), -1);
+ TclDStringAppendLiteral(dsPtr, " ");
+ TclDStringAppendObj(dsPtr, reqv[i]);
}
} else {
- Tcl_DStringAppend(dsPtr, " 0-", -1);
+ TclDStringAppendLiteral(dsPtr, " 0-");
}
}
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 7b0af3a..537008c 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -194,7 +194,7 @@ Tcl_ProcObjCmd(
Tcl_DStringInit(&ds);
if (nsPtr != iPtr->globalNsPtr) {
Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
- Tcl_DStringAppend(&ds, "::", 2);
+ TclDStringAppendLiteral(&ds, "::");
}
Tcl_DStringAppend(&ds, procName, -1);
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 1b671d4..ca2638c 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -55,6 +55,7 @@ static int TclSockMinimumBuffersOld(int sock, int size)
#ifdef __WIN32__
# define TclUnixWaitForFile 0
+# define TclUnixCopyFile 0
# define TclpReaddir 0
# define TclpIsAtty 0
#elif defined(__CYGWIN__)
@@ -498,7 +499,7 @@ static const TclIntPlatStubs tclIntPlatStubs = {
TclpCreatePipe, /* 14 */
TclpCreateProcess, /* 15 */
TclpIsAtty, /* 16 */
- 0, /* 17 */
+ TclUnixCopyFile, /* 17 */
TclpMakeFile, /* 18 */
TclpOpenFile, /* 19 */
TclWinAddProcess, /* 20 */
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 25abdff..529c38a 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -1298,9 +1298,9 @@ TraceCommandProc(
Tcl_DStringAppendElement(&cmd, oldName);
Tcl_DStringAppendElement(&cmd, (newName ? newName : ""));
if (flags & TCL_TRACE_RENAME) {
- Tcl_DStringAppend(&cmd, " rename", 7);
+ TclDStringAppendLiteral(&cmd, " rename");
} else if (flags & TCL_TRACE_DELETE) {
- Tcl_DStringAppend(&cmd, " delete", 7);
+ TclDStringAppendLiteral(&cmd, " delete");
}
/*
@@ -1994,24 +1994,24 @@ TraceVarProc(
#ifndef TCL_REMOVE_OBSOLETE_TRACES
if (tvarPtr->flags & TCL_TRACE_OLD_STYLE) {
if (flags & TCL_TRACE_ARRAY) {
- Tcl_DStringAppend(&cmd, " a", 2);
+ TclDStringAppendLiteral(&cmd, " a");
} else if (flags & TCL_TRACE_READS) {
- Tcl_DStringAppend(&cmd, " r", 2);
+ TclDStringAppendLiteral(&cmd, " r");
} else if (flags & TCL_TRACE_WRITES) {
- Tcl_DStringAppend(&cmd, " w", 2);
+ TclDStringAppendLiteral(&cmd, " w");
} else if (flags & TCL_TRACE_UNSETS) {
- Tcl_DStringAppend(&cmd, " u", 2);
+ TclDStringAppendLiteral(&cmd, " u");
}
} else {
#endif
if (flags & TCL_TRACE_ARRAY) {
- Tcl_DStringAppend(&cmd, " array", 6);
+ TclDStringAppendLiteral(&cmd, " array");
} else if (flags & TCL_TRACE_READS) {
- Tcl_DStringAppend(&cmd, " read", 5);
+ TclDStringAppendLiteral(&cmd, " read");
} else if (flags & TCL_TRACE_WRITES) {
- Tcl_DStringAppend(&cmd, " write", 6);
+ TclDStringAppendLiteral(&cmd, " write");
} else if (flags & TCL_TRACE_UNSETS) {
- Tcl_DStringAppend(&cmd, " unset", 6);
+ TclDStringAppendLiteral(&cmd, " unset");
}
#ifndef TCL_REMOVE_OBSOLETE_TRACES
}
@@ -2577,7 +2577,7 @@ TclCallVarTraces(
char *newPart1;
Tcl_DStringInit(&nameCopy);
- Tcl_DStringAppend(&nameCopy, part1, (p-part1));
+ Tcl_DStringAppend(&nameCopy, part1, p-part1);
newPart1 = Tcl_DStringValue(&nameCopy);
newPart1[offset] = 0;
part1 = newPart1;
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index d5a3b94..3379f6c 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -2438,6 +2438,37 @@ Tcl_DStringAppend(
/*
*----------------------------------------------------------------------
*
+ * TclDStringAppendObj, TclDStringAppendDString --
+ *
+ * Simple wrappers round Tcl_DStringAppend that make it easier to append
+ * from particular sources of strings.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclDStringAppendObj(
+ Tcl_DString *dsPtr,
+ Tcl_Obj *objPtr)
+{
+ int length;
+ char *bytes = Tcl_GetStringFromObj(objPtr, &length);
+
+ return Tcl_DStringAppend(dsPtr, bytes, length);
+}
+
+char *
+TclDStringAppendDString(
+ Tcl_DString *dsPtr,
+ Tcl_DString *toAppendPtr)
+{
+ return Tcl_DStringAppend(dsPtr, Tcl_DStringValue(toAppendPtr),
+ Tcl_DStringLength(toAppendPtr));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_DStringAppendElement --
*
* Append a list element to the current value of a dynamic string.
@@ -2793,9 +2824,9 @@ Tcl_DStringStartSublist(
Tcl_DString *dsPtr) /* Dynamic string. */
{
if (TclNeedSpace(dsPtr->string, dsPtr->string + dsPtr->length)) {
- Tcl_DStringAppend(dsPtr, " {", -1);
+ TclDStringAppendLiteral(dsPtr, " {");
} else {
- Tcl_DStringAppend(dsPtr, "{", -1);
+ TclDStringAppendLiteral(dsPtr, "{");
}
}
@@ -2821,7 +2852,7 @@ void
Tcl_DStringEndSublist(
Tcl_DString *dsPtr) /* Dynamic string. */
{
- Tcl_DStringAppend(dsPtr, "}", -1);
+ TclDStringAppendLiteral(dsPtr, "}");
}
/*
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index c96594d..a4ce05b 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -766,9 +766,8 @@ Tcl_ZlibStreamInit(
goto error;
}
Tcl_DStringInit(&cmdname);
- Tcl_DStringAppend(&cmdname, "::tcl::zlib::streamcmd_", -1);
- Tcl_DStringAppend(&cmdname, Tcl_GetString(Tcl_GetObjResult(interp)),
- -1);
+ TclDStringAppendLiteral(&cmdname, "::tcl::zlib::streamcmd_");
+ TclDStringAppendObj(&cmdname, Tcl_GetObjResult(interp));
if (Tcl_GetCommandInfo(interp, Tcl_DStringValue(&cmdname),
&cmdinfo) == 1) {
Tcl_SetResult(interp,
@@ -3337,10 +3336,7 @@ ZlibTransformGetOption(
Tcl_DStringAppendElement(dsPtr, Tcl_GetString(tmpObj));
Tcl_DecrRefCount(tmpObj);
} else {
- int len;
- const char *str = Tcl_GetStringFromObj(tmpObj, &len);
-
- Tcl_DStringAppend(dsPtr, str, len);
+ TclDStringAppendObj(dsPtr, tmpObj);
Tcl_DecrRefCount(tmpObj);
return TCL_OK;
}
@@ -3698,7 +3694,7 @@ ResultCopy(
*/
memcpy(buf, Tcl_DStringValue(&cd->decompressed), have);
- Tcl_DStringSetLength(&cd->decompressed, 0);
+ TclDStringClear(&cd->decompressed);
return have;
}
}
diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl
index 369ed52..3377b47 100644
--- a/library/msgcat/msgcat.tcl
+++ b/library/msgcat/msgcat.tcl
@@ -13,7 +13,7 @@
package require Tcl 8.5
# When the version number changes, be sure to update the pkgIndex.tcl file,
# and the installation directory in the Makefiles.
-package provide msgcat 1.4.4
+package provide msgcat 1.4.5
namespace eval msgcat {
namespace export mc mcload mclocale mcmax mcmset mcpreferences mcset \
@@ -32,7 +32,7 @@ namespace eval msgcat {
variable Msgs [dict create]
# Map of language codes used in Windows registry to those of ISO-639
- if { $::tcl_platform(platform) eq "windows" } {
+ if {[info sharedlibextension] eq ".dll"} {
variable WinRegToISO639 [dict create {*}{
01 ar 0401 ar_SA 0801 ar_IQ 0c01 ar_EG 1001 ar_LY 1401 ar_DZ
1801 ar_MA 1c01 ar_TN 2001 ar_OM 2401 ar_YE 2801 ar_SY
@@ -66,8 +66,8 @@ namespace eval msgcat {
15 pl 0415 pl_PL
16 pt 0416 pt_BR 0816 pt_PT
17 rm 0417 rm_CH
- 18 ro 0418 ro_RO
- 19 ru
+ 18 ro 0418 ro_RO 0818 ro_MO
+ 19 ru 0819 ru_MO
1a hr 041a hr_HR 081a sr_YU 0c1a sr_YU@cyrillic
1b sk 041b sk_SK
1c sq 041c sq_AL
@@ -92,6 +92,7 @@ namespace eval msgcat {
2f mk 042f mk_MK
30 bnt 0430 bnt_TZ
31 ts 0431 ts_ZA
+ 32 tn
33 ven 0433 ven_ZA
34 xh 0434 xh_ZA
35 zu 0435 zu_ZA
@@ -341,7 +342,7 @@ proc msgcat::mcmset {locale pairs } {
set ns [uplevel 1 [list ::namespace current]]
foreach {src dest} $pairs {
- dict set Msgs $locale $ns $src $dest
+ dict set Msgs $locale $ns $src $dest
}
return $length
@@ -387,10 +388,10 @@ proc msgcat::mcmax {args} {
set max 0
foreach string $args {
set translated [uplevel 1 [list [namespace origin mc] $string]]
- set len [string length $translated]
- if {$len>$max} {
+ set len [string length $translated]
+ if {$len>$max} {
set max $len
- }
+ }
}
return $max
}
@@ -426,7 +427,7 @@ proc msgcat::ConvertLocale {value} {
# Initialize the default locale
proc msgcat::Init {} {
- global env tcl_platform
+ global env
#
# set default locale, try to get from environment
@@ -451,23 +452,52 @@ proc msgcat::Init {} {
}
}
#
- # The rest of this routine is special processing for Windows;
- # all other platforms, get out now.
+ # The rest of this routine is special processing for Windows or
+ # Cygwin. All other platforms, get out now.
#
- if {$tcl_platform(platform) ne "windows"} {
+ if {([info sharedlibextension] ne ".dll")
+ || [catch {package require registry}]} {
mclocale C
return
}
#
- # On Windows, try to set locale depending on registry settings,
- # or fall back on locale of "C".
+ # On Windows or Cygwin, try to set locale depending on registry
+ # settings, or fall back on locale of "C".
+ #
+
+ # First check registry value LocalName present from Windows Vista
+ # which contains the local string as RFC5646, composed of:
+ # [a-z]{2,3} : language
+ # -[a-z]{4} : script (optional, translated by table Latn->latin)
+ # -[a-z]{2}|[0-9]{3} : territory (optional, numerical region codes not used)
+ # (-.*)* : variant, extension, private use (optional, not used)
+ # Those are translated to local strings.
+ # Examples: de-CH -> de_ch, sr-Latn-CS -> sr_cs@latin, es-419 -> es
#
+ set key {HKEY_CURRENT_USER\Control Panel\International}
+ if {([registry values $key "LocaleName"] ne "")
+ && [regexp {^([a-z]{2,3})(?:-([a-z]{4}))?(?:-([a-z]{2}))?(?:-.+)?$}\
+ [string tolower [registry get $key "LocaleName"]] match locale\
+ script territory]} {
+ if {"" ne $territory} {
+ append locale _ $territory
+ }
+ set modifierDict [dict create latn latin cyrl cyrillic]
+ if {[dict exists $modifierDict $script]} {
+ append locale @ [dict get $modifierDict $script]
+ }
+ if {![catch {
+ mclocale [ConvertLocale $locale]
+ }]} {
+ return
+ }
+ }
+
+ # then check key locale which contains a numerical language ID
if {[catch {
- package require registry
- set key {HKEY_CURRENT_USER\Control Panel\International}
set locale [registry get $key "locale"]
}]} {
- mclocale C
+ mclocale C
return
}
#
diff --git a/library/msgcat/pkgIndex.tcl b/library/msgcat/pkgIndex.tcl
index 17ad5db..60c2d3c 100644
--- a/library/msgcat/pkgIndex.tcl
+++ b/library/msgcat/pkgIndex.tcl
@@ -1,2 +1,2 @@
if {![package vsatisfies [package provide Tcl] 8.5]} {return}
-package ifneeded msgcat 1.4.4 [list source [file join $dir msgcat.tcl]]
+package ifneeded msgcat 1.4.5 [list source [file join $dir msgcat.tcl]]
diff --git a/tests/encoding.test b/tests/encoding.test
index 51b7aa1..b4ee7c3 100644
--- a/tests/encoding.test
+++ b/tests/encoding.test
@@ -582,6 +582,14 @@ file delete {*}[glob -directory [temporaryDirectory] *.chars *.tcltestout]
# EscapeFreeProc, GetTableEncoding, unilen are fully tested by the rest of
# this file.
+
+test encoding-27.1 {encoding dirs basic behavior} -returnCodes error -body {
+ encoding dirs ? ?
+} -result {wrong # args: should be "encoding dirs ?dirList?"}
+test encoding-27.2 {encoding dirs basic behavior} -returnCodes error -body {
+ encoding dirs "\{not a list"
+} -result "expected directory list but got \"\{not a list\""
+
}
runtests
diff --git a/tests/msgcat.test b/tests/msgcat.test
index 6fe4b31..bbcd023 100644
--- a/tests/msgcat.test
+++ b/tests/msgcat.test
@@ -17,8 +17,8 @@ if {[catch {package require tcltest 2}]} {
puts stderr "Skipping tests in [info script]. tcltest 2 required."
return
}
-if {[catch {package require msgcat 1.4.4}]} {
- puts stderr "Skipping tests in [info script]. No msgcat 1.4.4 found to test."
+if {[catch {package require msgcat 1.4.5}]} {
+ puts stderr "Skipping tests in [info script]. No msgcat 1.4.5 found to test."
return
}
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 0c63c3f..2e47714 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -238,7 +238,7 @@ DLTEST_DIR = @TCL_SRC_DIR@/unix/dltest
# Must be absolute to so the corresponding tcltest's tcl_library is absolute.
TCL_BUILDTIME_LIBRARY = @TCL_SRC_DIR@/library
-ZLIB_DIR = @ZLIB_DIR@
+ZLIB_DIR = ${COMPAT_DIR}/zlib
ZLIB_INCLUDE = @ZLIB_INCLUDE@
CC = @CC@
@@ -614,6 +614,10 @@ doc:
${LIB_FILE}: ${OBJS} ${STUB_LIB_FILE}
rm -f $@
@MAKE_LIB@
+ @if test "x$(DLL_INSTALL_DIR)" = "x$(BIN_INSTALL_DIR)"; then\
+ cp ${ZLIB_DIR}/win32/zlib1.dll .;\
+ fi
+
${STUB_LIB_FILE}: ${STUB_LIB_OBJS}
rm -f $@
@@ -783,16 +787,21 @@ install-binaries: binaries
else true; \
fi; \
done;
+ @if test "x$(DLL_INSTALL_DIR)" = "x$(BIN_INSTALL_DIR)"; then\
+ echo "Installing zlib1.dll to $(BIN_INSTALL_DIR)/";\
+ $(INSTALL_LIBRARY) zlib1.dll "$(BIN_INSTALL_DIR)";\
+ chmod 555 "$(BIN_INSTALL_DIR)/zlib1.dll";\
+ fi
@echo "Installing $(LIB_FILE) to $(DLL_INSTALL_DIR)/"
@@INSTALL_LIB@
- @chmod 555 "$(DLL_INSTALL_DIR)"/$(LIB_FILE)
+ @chmod 555 "$(DLL_INSTALL_DIR)/$(LIB_FILE)"
@echo "Installing ${TCL_EXE} as $(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}"
- @$(INSTALL_PROGRAM) ${TCL_EXE} "$(BIN_INSTALL_DIR)"/tclsh$(VERSION)${EXE_SUFFIX}
+ @$(INSTALL_PROGRAM) ${TCL_EXE} "$(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}"
@echo "Installing tclConfig.sh to $(CONFIG_INSTALL_DIR)/"
- @$(INSTALL_DATA) tclConfig.sh "$(CONFIG_INSTALL_DIR)"/tclConfig.sh
+ @$(INSTALL_DATA) tclConfig.sh "$(CONFIG_INSTALL_DIR)/tclConfig.sh"
@echo "Installing tclooConfig.sh to $(CONFIG_INSTALL_DIR)/"
@$(INSTALL_DATA) $(UNIX_DIR)/tclooConfig.sh \
- "$(CONFIG_INSTALL_DIR)"/tclooConfig.sh
+ "$(CONFIG_INSTALL_DIR)/tclooConfig.sh"
@if test "$(STUB_LIB_FILE)" != "" ; then \
echo "Installing $(STUB_LIB_FILE) to $(LIB_INSTALL_DIR)/"; \
@INSTALL_STUB_LIB@ ; \
@@ -837,8 +846,8 @@ install-libraries: libraries
do \
$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \
done;
- @echo "Installing package msgcat 1.4.4 as a Tcl Module";
- @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.4.4.tm;
+ @echo "Installing package msgcat 1.4.5 as a Tcl Module";
+ @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.4.5.tm;
@echo "Installing package tcltest 2.3.4 as a Tcl Module";
@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.4.tm;
diff --git a/unix/configure b/unix/configure
index 4fd92e2..2e36ad2 100755
--- a/unix/configure
+++ b/unix/configure
@@ -308,7 +308,7 @@ ac_includes_default="\
# include <unistd.h>
#endif"
-ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAN_FLAGS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP TCL_THREADS TCLSH_PROG ZLIB_DIR ZLIB_OBJS ZLIB_SRCS ZLIB_INCLUDE RANLIB ac_ct_RANLIB AR ac_ct_AR LIBOBJS TCL_LIBS DL_LIBS DL_OBJS PLAT_OBJS PLAT_SRCS LDAIX_SRC CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING LDFLAGS_DEBUG LDFLAGS_OPTIMIZE CC_SEARCH_FLAGS LD_SEARCH_FLAGS STLIB_LD SHLIB_LD TCL_SHLIB_LD_EXTRAS TK_SHLIB_LD_EXTRAS SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX MAKE_LIB MAKE_STUB_LIB INSTALL_LIB DLL_INSTALL_DIR INSTALL_STUB_LIB CFLAGS_DEFAULT LDFLAGS_DEFAULT DTRACE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_YEAR PKG_CFG_ARGS TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_SRC_DIR CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX TCL_SHARED_BUILD LD_LIBRARY_PATH_VAR TCL_BUILD_LIB_SPEC TCL_LIB_VERSIONS_OK TCL_SHARED_LIB_SUFFIX TCL_UNSHARED_LIB_SUFFIX TCL_HAS_LONGLONG INSTALL_TZDATA DTRACE_SRC DTRACE_HDR DTRACE_OBJ MAKEFILE_SHELL BUILD_DLTEST TCL_PACKAGE_PATH TCL_MODULE_PATH TCL_LIBRARY PRIVATE_INCLUDE_DIR HTML_DIR PACKAGE_DIR EXTRA_CC_SWITCHES EXTRA_APP_CC_SWITCHES EXTRA_INSTALL EXTRA_INSTALL_BINARIES EXTRA_BUILD_HTML EXTRA_TCLSH_LIBS DLTEST_LD DLTEST_SUFFIX'
+ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAN_FLAGS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP TCL_THREADS TCLSH_PROG ZLIB_OBJS ZLIB_SRCS ZLIB_INCLUDE RANLIB ac_ct_RANLIB AR ac_ct_AR LIBOBJS TCL_LIBS DL_LIBS DL_OBJS PLAT_OBJS PLAT_SRCS LDAIX_SRC CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING LDFLAGS_DEBUG LDFLAGS_OPTIMIZE CC_SEARCH_FLAGS LD_SEARCH_FLAGS STLIB_LD SHLIB_LD TCL_SHLIB_LD_EXTRAS TK_SHLIB_LD_EXTRAS SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX MAKE_LIB MAKE_STUB_LIB INSTALL_LIB DLL_INSTALL_DIR INSTALL_STUB_LIB CFLAGS_DEFAULT LDFLAGS_DEFAULT DTRACE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_YEAR PKG_CFG_ARGS TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_SRC_DIR CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX TCL_SHARED_BUILD LD_LIBRARY_PATH_VAR TCL_BUILD_LIB_SPEC TCL_LIB_VERSIONS_OK TCL_SHARED_LIB_SUFFIX TCL_UNSHARED_LIB_SUFFIX TCL_HAS_LONGLONG INSTALL_TZDATA DTRACE_SRC DTRACE_HDR DTRACE_OBJ MAKEFILE_SHELL BUILD_DLTEST TCL_PACKAGE_PATH TCL_MODULE_PATH TCL_LIBRARY PRIVATE_INCLUDE_DIR HTML_DIR PACKAGE_DIR EXTRA_CC_SWITCHES EXTRA_APP_CC_SWITCHES EXTRA_INSTALL EXTRA_INSTALL_BINARIES EXTRA_BUILD_HTML EXTRA_TCLSH_LIBS DLTEST_LD DLTEST_SUFFIX'
ac_subst_files=''
# Initialize some variables set by options.
@@ -6337,8 +6337,6 @@ fi
if test $zlib_ok = no; then
- ZLIB_DIR=\${COMPAT_DIR}/zlib
-
ZLIB_OBJS=\${ZLIB_OBJS}
ZLIB_SRCS=\${ZLIB_SRCS}
@@ -7137,7 +7135,7 @@ echo "$as_me: error: ${CC} is not a cygwin compiler." >&2;}
echo "$as_me: error: CYGWIN compile is only supported with --enable-threads" >&2;}
{ (exit 1); exit 1; }; }
fi
- if test ! -f "../win/tcldde14.dll" -a ! -f "../win/tk86.dll"; then
+ if test "x${SHARED_BUILD}" = "x1" -a ! -f "../win/tcldde14.dll" -a ! -f "../win/tk86.dll"; then
{ { echo "$as_me:$LINENO: error: Please configure and make the ../win directory first." >&5
echo "$as_me: error: Please configure and make the ../win directory first." >&2;}
{ (exit 1); exit 1; }; }
@@ -9152,15 +9150,15 @@ fi
if test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""; then
LIB_SUFFIX=${SHARED_LIB_SUFFIX}
- MAKE_LIB='${SHLIB_LD} -o $@ ${OBJS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}'
+ MAKE_LIB='${SHLIB_LD} -o $@ ${OBJS} ${TCL_SHLIB_LD_EXTRAS} ${SHLIB_LD_LIBS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}'
if test "${SHLIB_SUFFIX}" = ".dll"; then
- INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)"/$(LIB_FILE)'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)"'
DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)"
else
- INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)"/$(LIB_FILE)'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"'
fi
@@ -9172,12 +9170,12 @@ else
if test "$RANLIB" = ""; then
MAKE_LIB='$(STLIB_LD) $@ ${OBJS}'
- INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)"/$(LIB_FILE)'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"'
else
MAKE_LIB='${STLIB_LD} $@ ${OBJS} ; ${RANLIB} $@'
- INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)"/$(LIB_FILE) ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(LIB_FILE))'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(LIB_FILE))'
fi
@@ -9194,7 +9192,7 @@ fi
else
MAKE_STUB_LIB='${STLIB_LD} $@ ${STUB_LIB_OBJS} ; ${RANLIB} $@'
- INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)"/$(STUB_LIB_FILE) ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(STUB_LIB_FILE))'
+ INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(STUB_LIB_FILE))'
fi
@@ -14401,8 +14399,12 @@ _ACEOF
# lack blkcnt_t.
#--------------------------------------------------------------------
-if test "$ac_cv_cygwin" != "yes"; then
-echo "$as_me:$LINENO: checking for struct stat.st_blocks" >&5
+if test "$ac_cv_cygwin" = "yes"; then
+ if test "x${SHARED_BUILD}" = "x1"; then
+ TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS} \${COMPAT_DIR}/zlib/win32/zdll.lib"
+ fi
+else
+ echo "$as_me:$LINENO: checking for struct stat.st_blocks" >&5
echo $ECHO_N "checking for struct stat.st_blocks... $ECHO_C" >&6
if test "${ac_cv_member_struct_stat_st_blocks+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
@@ -20223,7 +20225,6 @@ s,@CPP@,$CPP,;t t
s,@EGREP@,$EGREP,;t t
s,@TCL_THREADS@,$TCL_THREADS,;t t
s,@TCLSH_PROG@,$TCLSH_PROG,;t t
-s,@ZLIB_DIR@,$ZLIB_DIR,;t t
s,@ZLIB_OBJS@,$ZLIB_OBJS,;t t
s,@ZLIB_SRCS@,$ZLIB_SRCS,;t t
s,@ZLIB_INCLUDE@,$ZLIB_INCLUDE,;t t
diff --git a/unix/configure.in b/unix/configure.in
index 726d4a8..79a546d 100644
--- a/unix/configure.in
+++ b/unix/configure.in
@@ -160,7 +160,6 @@ AS_IF([test $zlib_ok = yes], [
zlib_ok=no
])])
AS_IF([test $zlib_ok = no], [
- AC_SUBST(ZLIB_DIR,[\${COMPAT_DIR}/zlib])
AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}])
AC_SUBST(ZLIB_SRCS,[\${ZLIB_SRCS}])
AC_SUBST(ZLIB_INCLUDE,[-I\${ZLIB_DIR}])
@@ -303,8 +302,12 @@ SC_TIME_HANDLER
# lack blkcnt_t.
#--------------------------------------------------------------------
-if test "$ac_cv_cygwin" != "yes"; then
-AC_CHECK_MEMBERS([struct stat.st_blocks, struct stat.st_blksize])
+if test "$ac_cv_cygwin" = "yes"; then
+ if test "x${SHARED_BUILD}" = "x1"; then
+ TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS} \${COMPAT_DIR}/zlib/win32/zdll.lib"
+ fi
+else
+ AC_CHECK_MEMBERS([struct stat.st_blocks, struct stat.st_blksize])
fi
AC_CHECK_TYPES([blkcnt_t])
AC_CHECK_FUNC(fstatfs, , [AC_DEFINE(NO_FSTATFS, 1, [Do we have fstatfs()?])])
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index fbb86b3..a142baf 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -1246,7 +1246,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
if test "x${TCL_THREADS}" = "x0"; then
AC_MSG_ERROR([CYGWIN compile is only supported with --enable-threads])
fi
- if test ! -f "../win/tcldde14.dll" -a ! -f "../win/tk86.dll"; then
+ if test "x${SHARED_BUILD}" = "x1" -a ! -f "../win/tcldde14.dll" -a ! -f "../win/tk86.dll"; then
AC_MSG_ERROR([Please configure and make the ../win directory first.])
fi
;;
@@ -2098,22 +2098,22 @@ dnl # preprocessing tests use only CPPFLAGS.
AS_IF([test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""], [
LIB_SUFFIX=${SHARED_LIB_SUFFIX}
- MAKE_LIB='${SHLIB_LD} -o [$]@ ${OBJS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}'
+ MAKE_LIB='${SHLIB_LD} -o [$]@ ${OBJS} ${TCL_SHLIB_LD_EXTRAS} ${SHLIB_LD_LIBS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}'
AS_IF([test "${SHLIB_SUFFIX}" = ".dll"], [
- INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)"/$(LIB_FILE)'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)"'
DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)"
], [
- INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)"/$(LIB_FILE)'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"'
])
], [
LIB_SUFFIX=${UNSHARED_LIB_SUFFIX}
AS_IF([test "$RANLIB" = ""], [
MAKE_LIB='$(STLIB_LD) [$]@ ${OBJS}'
- INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)"/$(LIB_FILE)'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"'
], [
MAKE_LIB='${STLIB_LD} [$]@ ${OBJS} ; ${RANLIB} [$]@'
- INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)"/$(LIB_FILE) ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(LIB_FILE))'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(LIB_FILE))'
])
])
@@ -2123,7 +2123,7 @@ dnl # preprocessing tests use only CPPFLAGS.
INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)"'
], [
MAKE_STUB_LIB='${STLIB_LD} [$]@ ${STUB_LIB_OBJS} ; ${RANLIB} [$]@'
- INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)"/$(STUB_LIB_FILE) ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(STUB_LIB_FILE))'
+ INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(STUB_LIB_FILE))'
])
# Define TCL_LIBS now that we know what DL_LIBS is.
diff --git a/unix/tclConfig.sh.in b/unix/tclConfig.sh.in
index 7e1d4af..d47e686 100644
--- a/unix/tclConfig.sh.in
+++ b/unix/tclConfig.sh.in
@@ -1,5 +1,5 @@
# tclConfig.sh --
-#
+#
# This shell script (for sh) is generated automatically by Tcl's
# configure script. It will create shell variables for most of
# the configuration options discovered by the configure script.
diff --git a/unix/tclLoadDl.c b/unix/tclLoadDl.c
index 96f0717..d86e7fd 100644
--- a/unix/tclLoadDl.c
+++ b/unix/tclLoadDl.c
@@ -168,7 +168,7 @@ FindSymbol(
proc = dlsym(handle, native); /* INTL: Native. */
if (proc == NULL) {
Tcl_DStringInit(&newName);
- Tcl_DStringAppend(&newName, "_", 1);
+ TclDStringAppendLiteral(&newName, "_");
native = Tcl_DStringAppend(&newName, native, -1);
proc = dlsym(handle, native); /* INTL: Native. */
Tcl_DStringFree(&newName);
diff --git a/unix/tclLoadDyld.c b/unix/tclLoadDyld.c
index 3fba3a5..31d15b2 100644
--- a/unix/tclLoadDyld.c
+++ b/unix/tclLoadDyld.c
@@ -393,7 +393,7 @@ FindSymbol(
*/
Tcl_DStringInit(&newName);
- Tcl_DStringAppend(&newName, "_", 1);
+ TclDStringAppendLiteral(&newName, "_");
native = Tcl_DStringAppend(&newName, native, -1);
if (dyldLoadHandle->dyldLibHeader) {
nsSymbol = NSLookupSymbolInImage(dyldLoadHandle->dyldLibHeader,
diff --git a/unix/tclLoadShl.c b/unix/tclLoadShl.c
index 9656983..eddd80a 100644
--- a/unix/tclLoadShl.c
+++ b/unix/tclLoadShl.c
@@ -146,7 +146,7 @@ FindSymbol(
if (shl_findsym(&handle, symbol, (short) TYPE_PROCEDURE,
(void *) &proc) != 0) {
Tcl_DStringInit(&newName);
- Tcl_DStringAppend(&newName, "_", 1);
+ TclDStringAppendLiteral(&newName, "_");
Tcl_DStringAppend(&newName, symbol, -1);
if (shl_findsym(&handle, Tcl_DStringValue(&newName),
(short) TYPE_PROCEDURE, (void *) &proc) != 0) {
@@ -156,8 +156,8 @@ FindSymbol(
}
if (proc == NULL && interp != NULL) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "cannot find symbol\"", symbol,
- "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_AppendResult(interp, "cannot find symbol\"", symbol, "\": ",
+ Tcl_PosixError(interp), NULL);
}
return proc;
}
diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c
index b05a9f2..3845c44 100644
--- a/unix/tclUnixChan.c
+++ b/unix/tclUnixChan.c
@@ -733,7 +733,7 @@ TtySetOptionProc(
Tcl_UtfToExternalDString(NULL, argv[0], -1, &ds);
iostate.c_cc[VSTART] = *(const cc_t *) Tcl_DStringValue(&ds);
- Tcl_DStringSetLength(&ds, 0);
+ TclDStringClear(&ds);
Tcl_UtfToExternalDString(NULL, argv[1], -1, &ds);
iostate.c_cc[VSTOP] = *(const cc_t *) Tcl_DStringValue(&ds);
@@ -916,7 +916,7 @@ TtyGetOptionProc(
Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTART], 1, &ds);
Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
- Tcl_DStringSetLength(&ds, 0);
+ TclDStringClear(&ds);
Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTOP], 1, &ds);
Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
index fce071f..a695e9c 100644
--- a/unix/tclUnixFCmd.c
+++ b/unix/tclUnixFCmd.c
@@ -967,11 +967,11 @@ TraverseUnixTree(
return result;
}
- Tcl_DStringAppend(sourcePtr, "/", 1);
+ TclDStringAppendLiteral(sourcePtr, "/");
sourceLen = Tcl_DStringLength(sourcePtr);
if (targetPtr != NULL) {
- Tcl_DStringAppend(targetPtr, "/", 1);
+ TclDStringAppendLiteral(targetPtr, "/");
targetLen = Tcl_DStringLength(targetPtr);
}
@@ -2125,24 +2125,24 @@ TclpOpenTemporaryFile(
Tcl_DStringAppend(&template, DefaultTempDir(), -1); /* INTL: native */
}
- Tcl_DStringAppend(&template, "/", -1);
+ TclDStringAppendLiteral(&template, "/");
if (basenameObj) {
string = Tcl_GetStringFromObj(basenameObj, &len);
Tcl_UtfToExternalDString(NULL, string, len, &tmp);
- Tcl_DStringAppend(&template, Tcl_DStringValue(&tmp), -1);
+ TclDStringAppendDString(&template, &tmp);
Tcl_DStringFree(&tmp);
} else {
- Tcl_DStringAppend(&template, "tcl", -1);
+ TclDStringAppendLiteral(&template, "tcl");
}
- Tcl_DStringAppend(&template, "_XXXXXX", -1);
+ TclDStringAppendLiteral(&template, "_XXXXXX");
#ifdef HAVE_MKSTEMPS
if (extensionObj) {
string = Tcl_GetStringFromObj(extensionObj, &len);
Tcl_UtfToExternalDString(NULL, string, len, &tmp);
- Tcl_DStringAppend(&template, Tcl_DStringValue(&tmp), -1);
+ TclDStringAppendDString(&template, &tmp);
fd = mkstemps(Tcl_DStringValue(&template), Tcl_DStringLength(&tmp));
Tcl_DStringFree(&tmp);
} else
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index 1c456a0..c213050 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -42,19 +42,18 @@ TclpFindExecutable(
Tcl_Encoding encoding;
#ifdef __CYGWIN__
int length;
- char buf[PATH_MAX * TCL_UTF_MAX + 1];
+ char buf[PATH_MAX * 2];
char name[PATH_MAX * TCL_UTF_MAX + 1];
- GetModuleFileNameW(NULL, name, PATH_MAX);
- WideCharToMultiByte(CP_UTF8, 0, name, -1, buf, PATH_MAX, NULL, NULL);
- cygwin_conv_to_full_posix_path(buf, name);
+ GetModuleFileNameW(NULL, buf, PATH_MAX);
+ cygwin_conv_path(3, buf, name, PATH_MAX);
length = strlen(name);
if ((length > 4) && !strcasecmp(name + length - 4, ".exe")) {
/* Strip '.exe' part. */
length -= 4;
}
- encoding = Tcl_GetEncoding(NULL, NULL);
- TclSetObjNameOfExecutable(
- Tcl_NewStringObj(name, length), encoding);
+ encoding = Tcl_GetEncoding(NULL, NULL);
+ TclSetObjNameOfExecutable(
+ Tcl_NewStringObj(name, length), encoding);
#else
const char *name, *p;
Tcl_StatBuf statBuf;
@@ -106,11 +105,11 @@ TclpFindExecutable(
while ((*p != ':') && (*p != 0)) {
p++;
}
- Tcl_DStringSetLength(&buffer, 0);
+ TclDStringClear(&buffer);
if (p != name) {
Tcl_DStringAppend(&buffer, name, p - name);
if (p[-1] != '/') {
- Tcl_DStringAppend(&buffer, "/", 1);
+ TclDStringAppendLiteral(&buffer, "/");
}
}
name = Tcl_DStringAppend(&buffer, argv0, -1);
@@ -175,11 +174,10 @@ TclpFindExecutable(
Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&cwd),
Tcl_DStringLength(&cwd), &buffer);
if (Tcl_DStringValue(&cwd)[Tcl_DStringLength(&cwd) -1] != '/') {
- Tcl_DStringAppend(&buffer, "/", 1);
+ TclDStringAppendLiteral(&buffer, "/");
}
Tcl_DStringFree(&cwd);
- Tcl_DStringAppend(&buffer, Tcl_DStringValue(&nameString),
- Tcl_DStringLength(&nameString));
+ TclDStringAppendDString(&buffer, &nameString);
Tcl_DStringFree(&nameString);
encoding = Tcl_GetEncoding(NULL, NULL);
@@ -289,7 +287,7 @@ TclpMatchInDirectory(
*/
if (dirName[dirLength-1] != '/') {
- dirName = Tcl_DStringAppend(&dsOrig, "/", 1);
+ dirName = TclDStringAppendLiteral(&dsOrig, "/");
dirLength++;
}
}
diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h
index 5229f58..63c500d 100644
--- a/unix/tclUnixPort.h
+++ b/unix/tclUnixPort.h
@@ -98,16 +98,14 @@ typedef off_t Tcl_SeekOffset;
DLLIMPORT extern __stdcall void OutputDebugStringW(const WCHAR *);
DLLIMPORT extern __stdcall int IsDebuggerPresent();
- DLLIMPORT extern int cygwin_conv_to_full_posix_path(const char *, char *);
+ DLLIMPORT extern int cygwin_conv_path(int, const void *, void *, int);
+ DLLIMPORT extern int cygwin_conv_path_list(int, const void *, void *, int);
# define USE_PUTENV 1
# define USE_PUTENV_FOR_UNSET 1
/* On Cygwin, the environment is imported from the Cygwin DLL. */
# define environ __cygwin_environ
# define timezone _timezone
DLLIMPORT extern char **__cygwin_environ;
- DLLIMPORT extern int cygwin_conv_to_win32_path(const char *, char *);
- DLLIMPORT extern int cygwin_posix_to_win32_path_list_buf_size(char *value);
- DLLIMPORT extern void cygwin_posix_to_win32_path_list(char *buf, char *value);
MODULE_SCOPE int TclOSstat(const char *name, Tcl_StatBuf *statBuf);
MODULE_SCOPE int TclOSlstat(const char *name, Tcl_StatBuf *statBuf);
#elif defined(HAVE_STRUCT_STAT64)
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index f6abfd5..1e9d4eb 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -1117,12 +1117,7 @@ Tcl_OpenTcpClient(
freeaddrinfo(addrlist);
}
if (interp != NULL) {
- Tcl_AppendResult(interp, "couldn't open socket: ", NULL);
- if (errorMsg == NULL) {
- Tcl_AppendResult(interp, Tcl_PosixError(interp), NULL);
- } else {
- Tcl_AppendResult(interp, errorMsg, NULL);
- }
+ Tcl_AppendResult(interp, "couldn't open socket: ", errorMsg, NULL);
}
return NULL;
}
diff --git a/win/Makefile.in b/win/Makefile.in
index 44ba581..d5a335d 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -669,8 +669,8 @@ install-libraries: libraries install-tzdata install-msgs
do \
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
done;
- @echo "Installing package msgcat 1.4.4 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.4.tm;
+ @echo "Installing package msgcat 1.4.5 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.5.tm;
@echo "Installing package tcltest 2.3.4 as a Tcl Module";
@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.4.tm;
@echo "Installing package platform 1.0.10 as a Tcl Module";
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c
index 9d0131e..77a5b82 100644
--- a/win/tclWinFCmd.c
+++ b/win/tclWinFCmd.c
@@ -1125,9 +1125,9 @@ DoRemoveJustDirectory(
len = strlen(path);
find = Tcl_DStringAppend(&buffer, path, len);
if ((len > 0) && (find[len - 1] != '\\')) {
- Tcl_DStringAppend(&buffer, "\\", 1);
+ TclDStringAppendLiteral(&buffer, "\\");
}
- find = Tcl_DStringAppend(&buffer, "*.*", 3);
+ find = TclDStringAppendLiteral(&buffer, "*.*");
handle = FindFirstFileA(find, &data);
if (handle != INVALID_HANDLE_VALUE) {
while (1) {
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 4a49b6c..1f56060 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -996,7 +996,7 @@ TclpMatchInDirectory(
lastChar = dirName[dirLength -1];
if ((lastChar != '\\') && (lastChar != '/') && (lastChar != ':')) {
- Tcl_DStringAppend(&dsOrig, "/", 1);
+ TclDStringAppendLiteral(&dsOrig, "/");
dirLength++;
}
dirName = Tcl_DStringValue(&dsOrig);
@@ -1016,7 +1016,7 @@ TclpMatchInDirectory(
dirName = Tcl_DStringAppend(&dsOrig, pattern, -1);
} else {
- dirName = Tcl_DStringAppend(&dsOrig, "*.*", 3);
+ dirName = TclDStringAppendLiteral(&dsOrig, "*.*");
}
native = Tcl_WinUtfToTChar(dirName, -1, &ds);
@@ -1467,7 +1467,7 @@ TclpGetUserHome(
GetWindowsDirectoryW(buf, MAX_PATH);
Tcl_UniCharToUtfDString(buf, 2, bufferPtr);
- Tcl_DStringAppend(bufferPtr, "/users/default", -1);
+ TclDStringAppendLiteral(bufferPtr, "/users/default");
}
result = Tcl_DStringValue(bufferPtr);
NetApiBufferFree((void *) uiPtr);
@@ -2076,7 +2076,7 @@ NativeDev(
* won't work.
*/
- fullPath = Tcl_DStringAppend(&ds, "\\", 1);
+ fullPath = TclDStringAppendLiteral(&ds, "\\");
p = fullPath + Tcl_DStringLength(&ds);
} else {
p++;
@@ -2536,7 +2536,7 @@ TclpObjNormalizePath(
* string.
*/
- Tcl_DStringAppend(&dsNorm,"/", 1);
+ TclDStringAppendLiteral(&dsNorm, "/");
} else {
char *nativeName;
@@ -2546,8 +2546,8 @@ TclpObjNormalizePath(
nativeName = fData.cAlternateFileName;
}
FindClose(handle);
- Tcl_DStringAppend(&dsNorm,"/", 1);
- Tcl_DStringAppend(&dsNorm,nativeName,-1);
+ TclDStringAppendLiteral(&dsNorm, "/");
+ Tcl_DStringAppend(&dsNorm, nativeName, -1);
}
}
}
diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c
index e5b927d..b59ccba 100644
--- a/win/tclWinLoad.c
+++ b/win/tclWinLoad.c
@@ -184,7 +184,7 @@ FindSymbol(
const char *sym2;
Tcl_DStringInit(&ds);
- Tcl_DStringAppend(&ds, "_", 1);
+ TclDStringAppendLiteral(&ds, "_");
sym2 = Tcl_DStringAppend(&ds, symbol, -1);
proc = (Tcl_PackageInitProc *) GetProcAddress(hInstance, sym2);
Tcl_DStringFree(&ds);
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index fd195c4..65d4d06 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -1115,7 +1115,7 @@ TclpCreateProcess(
startInfo.wShowWindow = SW_HIDE;
startInfo.dwFlags |= STARTF_USESHOWWINDOW;
createFlags = CREATE_NEW_CONSOLE;
- Tcl_DStringAppend(&cmdLine, "cmd.exe /c", -1);
+ TclDStringAppendLiteral(&cmdLine, "cmd.exe /c");
} else {
createFlags = DETACHED_PROCESS;
}
@@ -1465,9 +1465,9 @@ BuildCommandLine(
* Prime the path. Add a space separator if we were primed with something.
*/
- Tcl_DStringAppend(&ds, Tcl_DStringValue(linePtr), -1);
+ TclDStringAppendDString(&ds, linePtr);
if (Tcl_DStringLength(linePtr) > 0) {
- Tcl_DStringAppend(&ds, " ", 1);
+ TclDStringAppendLiteral(&ds, " ");
}
for (i = 0; i < argc; i++) {
@@ -1475,7 +1475,7 @@ BuildCommandLine(
arg = executable;
} else {
arg = argv[i];
- Tcl_DStringAppend(&ds, " ", 1);
+ TclDStringAppendLiteral(&ds, " ");
}
quote = 0;
@@ -1494,7 +1494,7 @@ BuildCommandLine(
}
}
if (quote) {
- Tcl_DStringAppend(&ds, "\"", 1);
+ TclDStringAppendLiteral(&ds, "\"");
}
start = arg;
for (special = arg; ; ) {
@@ -1523,7 +1523,7 @@ BuildCommandLine(
}
if (*special == '"') {
Tcl_DStringAppend(&ds, start, (int) (special - start));
- Tcl_DStringAppend(&ds, "\\\"", 2);
+ TclDStringAppendLiteral(&ds, "\\\"");
start = special + 1;
}
if (*special == '\0') {
@@ -1533,7 +1533,7 @@ BuildCommandLine(
}
Tcl_DStringAppend(&ds, start, (int) (special - start));
if (quote) {
- Tcl_DStringAppend(&ds, "\"", 1);
+ TclDStringAppendLiteral(&ds, "\"");
}
}
Tcl_DStringFree(linePtr);
diff --git a/win/tclWinReg.c b/win/tclWinReg.c
index c508fdf..10437e6 100644
--- a/win/tclWinReg.c
+++ b/win/tclWinReg.c
@@ -889,8 +889,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(TCHAR)));
index = 0;
result = TCL_OK;
@@ -1192,8 +1191,7 @@ RecursiveDeleteKey(
}
Tcl_DStringInit(&subkey);
- Tcl_DStringSetLength(&subkey,
- (int) (MAX_KEY_LENGTH * sizeof(TCHAR)));
+ Tcl_DStringSetLength(&subkey, (int) (MAX_KEY_LENGTH * sizeof(TCHAR)));
mode = saveMode;
while (result == ERROR_SUCCESS) {
@@ -1318,7 +1316,7 @@ SetValue(
Tcl_DStringInit(&data);
for (i = 0; i < objc; i++) {
- Tcl_DStringAppend(&data, Tcl_GetString(objv[i]), -1);
+ TclDStringAppendObj(&data, objv[i]);
/*
* Add a null character to separate this value from the next. We
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 166fdfd..ca49d22 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -2590,11 +2590,11 @@ InitializeHostName(
Tcl_DStringInit(&inDs);
Tcl_DStringSetLength(&inDs, 255);
if (gethostname(Tcl_DStringValue(&inDs),
- Tcl_DStringLength(&inDs)) == 0) {
- Tcl_DStringSetLength(&ds, 0);
+ Tcl_DStringLength(&inDs)) == 0) {
+ TclDStringClear(&ds);
} else {
- Tcl_ExternalToUtfDString(NULL,
- Tcl_DStringValue(&inDs), -1, &ds);
+ Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs), -1,
+ &ds);
}
Tcl_DStringFree(&inDs);
}