summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2013-06-18 13:27:55 (GMT)
committerdgp <dgp@users.sourceforge.net>2013-06-18 13:27:55 (GMT)
commit03c2b713c919e184d47b24a3dc46c3ed334f1062 (patch)
tree841bf6dc2a71f923b1c842642e632d7f9f5aca5d
parent94fa8ab1ad3bafdbe3779f2ba8b60857a76a4985 (diff)
parent914227b03938ff6da7a4b35ef2e9a2b495df3ba0 (diff)
downloadtcl-03c2b713c919e184d47b24a3dc46c3ed334f1062.zip
tcl-03c2b713c919e184d47b24a3dc46c3ed334f1062.tar.gz
tcl-03c2b713c919e184d47b24a3dc46c3ed334f1062.tar.bz2
Merge to near-8.5-branch-tip.
-rw-r--r--ChangeLog55
-rw-r--r--README29
-rw-r--r--changes4
-rw-r--r--doc/msgcat.n7
-rw-r--r--generic/regc_locale.c5
-rw-r--r--generic/regguts.h6
-rw-r--r--generic/tcl.h10
-rw-r--r--generic/tclBasic.c12
-rw-r--r--generic/tclCmdAH.c7
-rw-r--r--generic/tclCmdIL.c13
-rw-r--r--generic/tclCmdMZ.c2
-rw-r--r--generic/tclDate.c2
-rw-r--r--generic/tclDecls.h48
-rw-r--r--generic/tclExecute.c19
-rw-r--r--generic/tclIO.c100
-rw-r--r--generic/tclIOCmd.c34
-rw-r--r--generic/tclInt.h1
-rw-r--r--generic/tclStubInit.c85
-rw-r--r--generic/tclThreadTest.c22
-rw-r--r--generic/tclUtf.c44
-rw-r--r--library/msgcat/msgcat.tcl39
-rw-r--r--library/msgcat/pkgIndex.tcl2
-rw-r--r--library/platform/pkgIndex.tcl2
-rw-r--r--library/platform/platform.tcl4
-rw-r--r--macosx/README4
-rw-r--r--tests/cmdIL.test9
-rw-r--r--tests/env.test4
-rw-r--r--tests/httpd2
-rw-r--r--tests/utf.test4
-rw-r--r--tools/uniClass.tcl2
-rw-r--r--unix/Makefile.in8
-rw-r--r--unix/README5
-rwxr-xr-xunix/configure66
-rw-r--r--unix/tcl.m435
-rw-r--r--unix/tclUnixPort.h4
-rw-r--r--win/Makefile.in8
-rw-r--r--win/README4
-rw-r--r--win/tclWinPort.h21
-rw-r--r--win/tclWinTime.c4
39 files changed, 498 insertions, 234 deletions
diff --git a/ChangeLog b/ChangeLog
index c2d3561..54c3b99 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,4 +1,57 @@
-2013-04-23 Jan Nijtmans <nijtmans@users.sf.net>
+2013-06-17 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/regc_locale.c: Bug [a876646efe]: re_expr character class
+ [:cntrl:] should contain \u0000 - \u001f
+
+2013-06-03 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c: fix for perf bug detected by Kieran
+ (https://groups.google.com/forum/?fromgroups#!topic/comp.lang.tcl/vfpI3bc-DkQ),
+ diagnosed by dgp to be a close relative of [Bug 781585], which was
+ fixed by commit [f46fb50cb3]. This bug was introduced by myself in
+ commit [cbfe055d8c].
+
+2013-05-28 Harald Oehlmann <oehhar@users.sf.net>
+
+ * library/msgcat/msgcat.tcl: [Bug 3036566]: Also get locale from
+ registry key HCU\Control Panel\Desktop : PreferredUILanguages to
+ honor installed language packs on Vista+.
+ Bumped msgcat version to 1.5.2
+
+2013-05-22 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclUtf.c (TclUtfCasecmp): [Bug 3613609]: Replace problematic
+ uses of strcasecmp with a proper UTF-8-aware version. Affects both
+ [lsearch -nocase] and [lsort -nocase].
+
+2013-05-19 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * unix/tcl.m4: Fix for FreeBSD, and remove support for older
+ * unix/configure: FreeBSD versions. Patch by Pietro Cerutti.
+
+2013-05-16 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclBasic.c: Add panic in order to detect
+ incompatible mingw32 sys/stat.h and sys/time.h headers,
+
+2013-05-06 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclStubInit.c: Add support for Cygwin64, which has a 64-bit
+ * generic/tclDecls.h: "long" type. Binary compatibility with win64
+ requires that all stub entries use 32-bit long's, therefore the
+ need for various wrapper functions/macros. For Tcl 9 a better
+ solution is needed, but that cannot be done without introducing
+ binary incompatibility.
+
+2013-04-30 Andreas Kupries <andreask@activestate.com>
+
+ * library/platform/platform.tcl (::platform::LibcVersion):
+ * library/platform/pkgIndex.tcl: Followup to the 2013-01-30
+ change. The RE become too restrictive again. SuSe added a
+ timestamp after the version. Loosened up a bit. Bumped package
+ to version 1.0.12.
+
+2013-04-25 Jan Nijtmans <nijtmans@users.sf.net>
* generic/tclDecls.h: Implement Tcl_NewBooleanObj, Tcl_DbNewBooleanObj
and Tcl_SetBooleanObj as macros using Tcl_NewIntObj, Tcl_DbNewLongObj
diff --git a/README b/README
index 8cc9b9a..0b3cf05 100644
--- a/README
+++ b/README
@@ -1,8 +1,7 @@
README: Tcl
This is the Tcl 8.5.14 source distribution.
- http://tcl.sourceforge.net/
- You can get any source release of Tcl from the file distributions
- link at the above URL.
+ http://sourceforge.net/projects/tcl/files/Tcl/
+ You can get any source release of Tcl from the URL above.
Contents
--------
@@ -27,9 +26,14 @@ Tcl can also be used for a variety of web-related tasks and for creating
powerful command languages for applications.
Tcl is maintained, enhanced, and distributed freely by the Tcl community.
-The home for Tcl/Tk releases and bug/patch database is on SourceForge:
+Source code development and tracking of bug reports and feature requests
+takes place at:
- http://tcl.sourceforge.net/
+ http://core.tcl.tk/
+
+Tcl/Tk release and mailing list services are hosted by SourceForge:
+
+ http://sourceforge.net/projects/tcl/
with the Tcl Developer Xchange hosted at:
@@ -49,7 +53,7 @@ The home page for this release, including new features, is
Detailed release notes can be found at the file distributions page
by clicking on the relevant version.
- http://sourceforge.net/projects/tcl/files/
+ http://sourceforge.net/projects/tcl/files/Tcl/
Information about Tcl itself can be found at
http://www.tcl.tk/about/
@@ -146,18 +150,13 @@ and go to the Mailing Lists page.
------------------------
We are very interested in receiving bug reports, patches, and suggestions
-for improvements. We prefer that you send this information to us via the
-bug form at SourceForge, rather than emailing us directly. The bug
-database is at:
-
- http://tcl.sourceforge.net/
+for improvements. We prefer that you send this information to us as
+tickets entered into our tracker at:
-The bug form was designed to give uniform structure to bug reports as
-well as to solicit enough information to minimize followup questions.
+ http://core.tcl.tk/tcl/reportlist
We will log and follow-up on each bug, although we cannot promise a
-specific turn-around time. Enhancements, reported via the Feature
-Requests form at the same web site, may take longer and may not happen
+specific turn-around time. Enhancements may take longer and may not happen
at all unless there is widespread support for them (we're trying to
slow the rate at which Tcl/Tk turns into a kitchen sink). It's very
difficult to make incompatible changes to Tcl/Tk at this point, due to
diff --git a/changes b/changes
index c4ad59d..78ade0e 100644
--- a/changes
+++ b/changes
@@ -7734,3 +7734,7 @@ Many revisions to better support a Cygwin environment (nijtmans)
2013-03-22 tzdata updated to Olson's tzdata2013b (venkat)
--- Released 8.5.14, April 3, 2013 --- See ChangeLog for details ---
+
+2013-05-08 (bug fix)[3036566] Honor language packs on Vista+ to get initial locale (oehlmann)
+=> msgcat 1.5.2
+
diff --git a/doc/msgcat.n b/doc/msgcat.n
index 47b6bf7..bfd94ae 100644
--- a/doc/msgcat.n
+++ b/doc/msgcat.n
@@ -35,7 +35,7 @@ msgcat \- Tcl message catalog
\fB::msgcat::mcflmset \fIsrc-trans-list\fR
.VE "TIP 404"
.sp
-\fB::msgcat::mcunknown \fIlocale src-string\fR
+\fB::msgcat::mcunknown \fIlocale src-string\fR ?\fIarg arg ...\fR?
.BE
.SH DESCRIPTION
.PP
@@ -157,12 +157,13 @@ translate-string\fR ?\fIsrc-string translate-string ...\fR?}
of \fB::msgcat::mcflset\fR. The function returns the number of translations set.
.VE "TIP 404"
.TP
-\fB::msgcat::mcunknown \fIlocale src-string\fR
+\fB::msgcat::mcunknown \fIlocale src-string\fR ?\fIarg arg ...\fR?
.
This routine is called by \fB::msgcat::mc\fR in the case when
a translation for \fIsrc-string\fR is not defined in the
current locale. The default action is to return
-\fIsrc-string\fR. This procedure can be redefined by the
+\fIsrc-string\fR passed by format if there are any arguments. This
+procedure can be redefined by the
application, for example to log error messages for each unknown
string. The \fB::msgcat::mcunknown\fR procedure is invoked at the
same stack context as the call to \fB::msgcat::mc\fR. The return value
diff --git a/generic/regc_locale.c b/generic/regc_locale.c
index 40791f4..dd1c01c 100644
--- a/generic/regc_locale.c
+++ b/generic/regc_locale.c
@@ -259,8 +259,9 @@ static const chr alphaCharTable[] = {
*/
static const crange controlRangeTable[] = {
- {0x7f, 0x9f}, {0x600, 0x604}, {0x200b, 0x200f}, {0x202a, 0x202e},
- {0x2060, 0x2064}, {0x206a, 0x206f}, {0xe000, 0xf8ff}, {0xfff9, 0xfffb}
+ {0x0, 0x1f}, {0x7f, 0x9f}, {0x600, 0x604}, {0x200b, 0x200f},
+ {0x202a, 0x202e}, {0x2060, 0x2064}, {0x206a, 0x206f}, {0xe000, 0xf8ff},
+ {0xfff9, 0xfffb}
#if TCL_UTF_MAX > 4
,{0x1d173, 0x1d17a}, {0xe0020, 0xe007f}, {0xf0000, 0xffffd}, {0x100000, 0x10fffd}
#endif
diff --git a/generic/regguts.h b/generic/regguts.h
index bfa7921..42654eb 100644
--- a/generic/regguts.h
+++ b/generic/regguts.h
@@ -358,12 +358,12 @@ struct subre {
#define CAP 010 /* capturing parens below */
#define BACKR 020 /* back reference below */
#define INUSE 0100 /* in use in final tree */
-#define LOCAL 03 /* bits which may not propagate up */
+#define NOPROP 03 /* bits which may not propagate up */
#define LMIX(f) ((f)<<2) /* LONGER -> MIXED */
#define SMIX(f) ((f)<<1) /* SHORTER -> MIXED */
-#define UP(f) (((f)&~LOCAL) | (LMIX(f) & SMIX(f) & MIXED))
+#define UP(f) (((f)&~NOPROP) | (LMIX(f) & SMIX(f) & MIXED))
#define MESSY(f) ((f)&(MIXED|CAP|BACKR))
-#define PREF(f) ((f)&LOCAL)
+#define PREF(f) ((f)&NOPROP)
#define PREF2(f1, f2) ((PREF(f1) != 0) ? PREF(f1) : PREF(f2))
#define COMBINE(f1, f2) (UP((f1)|(f2)) | PREF2(f1, f2))
short retry; /* index into retry memory */
diff --git a/generic/tcl.h b/generic/tcl.h
index cb63d41..be5e697 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -293,10 +293,12 @@ typedef long LONG;
* in ANSI C; maps them to type "char *" in non-ANSI systems.
*/
-#ifndef NO_VOID
-#define VOID void
-#else
-#define VOID char
+#ifndef __VXWORKS__
+# ifndef NO_VOID
+# define VOID void
+# else
+# define VOID char
+# endif
#endif
/*
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index d3b5490..4f24515 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -410,6 +410,18 @@ Tcl_CreateInterp(void)
Tcl_Panic("Tcl_CallFrame must not be smaller than CallFrame");
}
+#if defined(_WIN32) && !defined(_WIN64)
+ if (sizeof(time_t) != 4) {
+ /*NOTREACHED*/
+ Tcl_Panic("<time.h> is not compatible with MSVC");
+ }
+ if ((TclOffset(Tcl_StatBuf,st_atime) != 32)
+ || (TclOffset(Tcl_StatBuf,st_ctime) != 40)) {
+ /*NOTREACHED*/
+ Tcl_Panic("<sys/stat.h> is not compatible with MSVC");
+ }
+#endif
+
/*
* Initialize support for namespaces and create the global namespace
* (whose name is ""; an alias is "::"). This also initializes the Tcl
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 44f08a3..7f0df83 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -130,8 +130,7 @@ Tcl_CaseObjCmd(
for (i = 0; i < caseObjc; i += 2) {
int patObjc, j;
const char **patObjv;
- char *pat;
- unsigned char *p;
+ char *pat, *p;
if (i == (caseObjc - 1)) {
Tcl_ResetResult(interp);
@@ -145,8 +144,8 @@ Tcl_CaseObjCmd(
*/
pat = TclGetString(caseObjv[i]);
- for (p = (unsigned char *) pat; *p != '\0'; p++) {
- if (isspace(*p) || (*p == '\\')) { /* INTL: ISO space, UCHAR */
+ for (p = pat; *p != '\0'; p++) {
+ if (TclIsSpaceProc(*p) || (*p == '\\')) {
break;
}
}
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 152e61d..ea9c1e4 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -2807,7 +2807,7 @@ Tcl_LsearchObjCmd(
dataType = INTEGER;
break;
case LSEARCH_NOCASE: /* -nocase */
- strCmpFn = strcasecmp;
+ strCmpFn = TclUtfCasecmp;
noCase = 1;
break;
case LSEARCH_NOT: /* -not */
@@ -3209,7 +3209,7 @@ Tcl_LsearchObjCmd(
*/
if (noCase) {
- match = (strcasecmp(bytes, patternBytes) == 0);
+ match = (TclUtfCasecmp(bytes, patternBytes) == 0);
} else {
match = (memcmp(bytes, patternBytes,
(size_t) length) == 0);
@@ -3460,7 +3460,8 @@ Tcl_LsortObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument values. */
{
- int i, j, index, indices, length, nocase = 0, sortMode, indexc;
+ int i, j, index, indices, length, nocase = 0, indexc;
+ int sortMode = SORTMODE_ASCII;
Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj, *indexPtr;
SortElement *elementArray, *elementPtr;
SortInfo sortInfo; /* Information about this sort that needs to
@@ -3712,7 +3713,7 @@ Tcl_LsortObjCmd(
goto done1;
}
elementArray[i].index.intValue = a;
- } else if (sortInfo.sortMode == SORTMODE_REAL) {
+ } else if (sortMode == SORTMODE_REAL) {
double a;
if (Tcl_GetDoubleFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) {
sortInfo.resultCode = TCL_ERROR;
@@ -3790,7 +3791,7 @@ Tcl_LsortObjCmd(
ckfree((char *)elementArray);
done:
- if (sortInfo.sortMode == SORTMODE_COMMAND) {
+ if (sortMode == SORTMODE_COMMAND) {
TclDecrRefCount(sortInfo.compareCmdPtr);
TclDecrRefCount(listObj);
sortInfo.compareCmdPtr = NULL;
@@ -3932,7 +3933,7 @@ SortCompare(
order = strcmp(elemPtr1->index.strValuePtr,
elemPtr2->index.strValuePtr);
} else if (infoPtr->sortMode == SORTMODE_ASCII_NC) {
- order = strcasecmp(elemPtr1->index.strValuePtr,
+ order = TclUtfCasecmp(elemPtr1->index.strValuePtr,
elemPtr2->index.strValuePtr);
} else if (infoPtr->sortMode == SORTMODE_DICTIONARY) {
order = DictionaryCompare(elemPtr1->index.strValuePtr,
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 0ad77aa..6fd468c 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -3436,7 +3436,7 @@ Tcl_SwitchObjCmd(
i++;
goto finishedOptions;
case OPT_NOCASE:
- strCmpFn = strcasecmp;
+ strCmpFn = TclUtfCasecmp;
noCase = 1;
break;
diff --git a/generic/tclDate.c b/generic/tclDate.c
index 59da2ea..0bda22f 100644
--- a/generic/tclDate.c
+++ b/generic/tclDate.c
@@ -2690,7 +2690,7 @@ TclDatelex(
location->first_column = yyInput - info->dateStart;
for ( ; ; ) {
- while (isspace(UCHAR(*yyInput))) {
+ while (TclIsSpaceProc(*yyInput)) {
yyInput++;
}
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 77402f8..4ca9f68 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -6591,6 +6591,54 @@ extern TclStubs *tclStubsPtr;
#define Tcl_UpVar(interp, frameName, varName, localName, flags) \
Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags)
+#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
+# if defined(__CYGWIN__) && defined(TCL_WIDE_INT_IS_LONG)
+/* On Cygwin64, long is 64-bit while on Win64 long is 32-bit. Therefore
+ * we have to make sure that all stub entries on Cygwin64 follow the
+ * Win64 signature. Cygwin64 stubbed extensions cannot use those stub
+ * entries any more, they should use the 64-bit alternatives where
+ * possible. Tcl 9 must find a better solution, but that cannot be done
+ * without introducing a binary incompatibility.
+ */
+# undef Tcl_DbNewLongObj
+# undef Tcl_GetLongFromObj
+# undef Tcl_NewLongObj
+# undef Tcl_SetLongObj
+# undef Tcl_ExprLong
+# undef Tcl_ExprLongObj
+# undef Tcl_UniCharNcmp
+# undef Tcl_UtfNcmp
+# undef Tcl_UtfNcasecmp
+# undef Tcl_UniCharNcasecmp
+# define Tcl_DbNewLongObj ((Tcl_Obj*(*)(long,const char*,int))Tcl_DbNewWideIntObj)
+# define Tcl_GetLongFromObj ((int(*)(Tcl_Interp*,Tcl_Obj*,long*))Tcl_GetWideIntFromObj)
+# define Tcl_NewLongObj ((Tcl_Obj*(*)(long))Tcl_NewWideIntObj)
+# define Tcl_SetLongObj ((void(*)(Tcl_Obj*,long))Tcl_SetWideIntObj)
+# define Tcl_ExprLong TclExprLong
+ static inline int TclExprLong(Tcl_Interp *interp, const char *string, long *ptr){
+ int intValue;
+ int result = tclStubsPtr->tcl_ExprLong(interp, string, (long *)&intValue);
+ if (result == TCL_OK) *ptr = (long)intValue;
+ return result;
+ }
+# define Tcl_ExprLongObj TclExprLongObj
+ static inline int TclExprLongObj(Tcl_Interp *interp, Tcl_Obj *obj, long *ptr){
+ int intValue;
+ int result = tclStubsPtr->tcl_ExprLongObj(interp, obj, (long *)&intValue);
+ if (result == TCL_OK) *ptr = (long)intValue;
+ return result;
+ }
+# define Tcl_UniCharNcmp(ucs,uct,n) \
+ ((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))tclStubsPtr->tcl_UniCharNcmp)(ucs,uct,(unsigned int)(n))
+# define Tcl_UtfNcmp(s1,s2,n) \
+ ((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcmp)(s1,s2,(unsigned int)(n))
+# define Tcl_UtfNcasecmp(s1,s2,n) \
+ ((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcasecmp)(s1,s2,(unsigned int)(n))
+# define Tcl_UniCharNcasecmp(ucs,uct,n) \
+ ((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))tclStubsPtr->tcl_UniCharNcasecmp)(ucs,uct,(unsigned int)(n))
+# endif
+#endif
+
/*
* Deprecated Tcl procedures:
*/
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 904c368..8fb8e63 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -836,13 +836,13 @@ TclFinalizeExecution(void)
(TCL_ALLOCALIGN/sizeof(Tcl_Obj *))
/*
- * OFFSET computes how many words have to be skipped until the next aligned
+ * wordSkip computes how many words have to be skipped until the next aligned
* word. Note that we are only interested in the low order bits of ptr, so
* that any possible information loss in PTR2INT is of no consequence.
*/
static inline int
-OFFSET(
+wordSkip(
void *ptr)
{
int mask = TCL_ALLOCALIGN-1;
@@ -855,7 +855,7 @@ OFFSET(
*/
#define MEMSTART(markerPtr) \
- ((markerPtr) + OFFSET(markerPtr))
+ ((markerPtr) + wordSkip(markerPtr))
/*
@@ -900,7 +900,7 @@ GrowEvaluationStack(
}
} else {
Tcl_Obj **tmpMarkerPtr = esPtr->tosPtr + 1;
- int offset = OFFSET(tmpMarkerPtr);
+ int offset = wordSkip(tmpMarkerPtr);
if (needed + offset < 0) {
/*
@@ -2424,11 +2424,6 @@ TclExecuteByteCode(
if (result == TCL_OK) {
Tcl_Obj *objPtr;
-#ifndef TCL_COMPILE_DEBUG
- if (*(pc+pcAdjustment) == INST_POP) {
- NEXT_INST_V((pcAdjustment+1), objc, 0);
- }
-#endif
/*
* Push the call's object result and continue execution with
* the next instruction.
@@ -2455,6 +2450,12 @@ TclExecuteByteCode(
TclNewObj(objPtr);
Tcl_IncrRefCount(objPtr);
iPtr->objResultPtr = objPtr;
+#ifndef TCL_COMPILE_DEBUG
+ if (*(pc+pcAdjustment) == INST_POP) {
+ TclDecrRefCount(objResultPtr);
+ NEXT_INST_V((pcAdjustment+1), objc, 0);
+ }
+#endif
NEXT_INST_V(pcAdjustment, objc, -1);
} else {
cleanup = objc;
diff --git a/generic/tclIO.c b/generic/tclIO.c
index b16bdbb..f1d8909 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -229,6 +229,7 @@ static int WriteChars(Channel *chanPtr, const char *src,
static Tcl_Obj * FixLevelCode(Tcl_Obj *msg);
static void SpliceChannel(Tcl_Channel chan);
static void CutChannel(Tcl_Channel chan);
+static int WillRead(Channel *chanPtr);
/*
* Simplifying helper macros. All may use their argument(s) multiple times.
@@ -344,6 +345,52 @@ static Tcl_ObjType tclChannelType = {
#define MAX_CHANNEL_BUFFER_SIZE (1024*1024)
/*
+ * ChanRead, dropped here by a time traveler, see 8.6
+ */
+static inline int
+ChanRead(
+ Channel *chanPtr,
+ char *dst,
+ int dstSize,
+ int *errnoPtr)
+{
+ if (WillRead(chanPtr) < 0) {
+ return -1;
+ }
+
+ return chanPtr->typePtr->inputProc(chanPtr->instanceData, dst, dstSize,
+ errnoPtr);
+}
+
+static inline Tcl_WideInt
+ChanSeek(
+ Channel *chanPtr,
+ Tcl_WideInt offset,
+ int mode,
+ int *errnoPtr)
+{
+ /*
+ * Note that we prefer the wideSeekProc if that field is available in the
+ * type and non-NULL.
+ */
+
+ if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) &&
+ chanPtr->typePtr->wideSeekProc != NULL) {
+ return chanPtr->typePtr->wideSeekProc(chanPtr->instanceData,
+ offset, mode, errnoPtr);
+ }
+
+ if (offset<Tcl_LongAsWide(LONG_MIN) || offset>Tcl_LongAsWide(LONG_MAX)) {
+ *errnoPtr = EOVERFLOW;
+ return Tcl_LongAsWide(-1);
+ }
+
+ return Tcl_LongAsWide(chanPtr->typePtr->seekProc(chanPtr->instanceData,
+ Tcl_WideAsLong(offset), mode, errnoPtr));
+}
+
+
+/*
*---------------------------------------------------------------------------
*
* TclInitIOSubsystem --
@@ -3548,6 +3595,33 @@ Tcl_WriteObj(
}
}
+static void WillWrite(Channel *chanPtr)
+{
+ int inputBuffered;
+
+ if ((chanPtr->typePtr->seekProc != NULL)
+ && ((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)) {
+ int ignore;
+ DiscardInputQueued(chanPtr->state, 0);
+ ChanSeek(chanPtr, - inputBuffered, SEEK_CUR, &ignore);
+ }
+}
+
+static int WillRead(Channel *chanPtr)
+{
+ if ((chanPtr->typePtr->seekProc != NULL)
+ && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) {
+ if ((chanPtr->state->curOutPtr != NULL)
+ && IsBufferReady(chanPtr->state->curOutPtr)) {
+ SetFlag(chanPtr->state, BUFFER_READY);
+ }
+ if (FlushChannel(NULL, chanPtr, 0) != 0) {
+ return -1;
+ }
+ }
+ return 0;
+}
+
/*
*----------------------------------------------------------------------
*
@@ -3581,6 +3655,10 @@ WriteBytes(
char *dst;
int dstMax, sawLF, savedLF, total, dstLen, toWrite, translate;
+ if (srcLen) {
+ WillWrite(chanPtr);
+ }
+
total = 0;
sawLF = 0;
savedLF = 0;
@@ -3682,6 +3760,10 @@ WriteChars(
Tcl_Encoding encoding;
char safe[BUFFER_PADDING];
+ if (srcLen) {
+ WillWrite(chanPtr);
+ }
+
total = 0;
sawLF = 0;
savedLF = 0;
@@ -5187,8 +5269,8 @@ Tcl_ReadRaw(
* The case of 'bytesToRead == 0' at this point cannot happen.
*/
- nread = (chanPtr->typePtr->inputProc)(chanPtr->instanceData,
- bufPtr + copied, bytesToRead - copied, &result);
+ nread = ChanRead(chanPtr, bufPtr + copied,
+ bytesToRead - copied, &result);
#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
}
@@ -6353,8 +6435,7 @@ GetInput(
} else {
#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
- nread = (chanPtr->typePtr->inputProc)(chanPtr->instanceData,
- InsertPoint(bufPtr), toRead, &result);
+ nread = ChanRead(chanPtr, InsertPoint(bufPtr), toRead, &result);
#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
}
@@ -6657,8 +6738,8 @@ Tcl_Tell(
outputBuffered = Tcl_OutputBuffered(chan);
if ((inputBuffered != 0) && (outputBuffered != 0)) {
- Tcl_SetErrno(EFAULT);
- return Tcl_LongAsWide(-1);
+ /*Tcl_SetErrno(EFAULT);*/
+ /*return Tcl_LongAsWide(-1);*/
}
/*
@@ -6679,6 +6760,7 @@ Tcl_Tell(
Tcl_SetErrno(result);
return Tcl_LongAsWide(-1);
}
+
if (inputBuffered != 0) {
return curPos - inputBuffered;
}
@@ -6780,8 +6862,10 @@ Tcl_TruncateChannel(
* pre-read input data.
*/
- if (Tcl_Seek(chan, (Tcl_WideInt)0, SEEK_CUR) == Tcl_LongAsWide(-1)) {
- return TCL_ERROR;
+ WillWrite(chanPtr);
+
+ if (WillRead(chanPtr) < 0) {
+ return TCL_ERROR;
}
/*
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 21dcd71..2958bc8 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -1823,24 +1823,24 @@ TclInitChanCmd(
* function at the moment.
*/
static const EnsembleImplMap initMap[] = {
- {"blocked", Tcl_FblockedObjCmd},
- {"close", Tcl_CloseObjCmd},
- {"copy", Tcl_FcopyObjCmd},
- {"create", TclChanCreateObjCmd}, /* TIP #219 */
- {"eof", Tcl_EofObjCmd},
- {"event", Tcl_FileEventObjCmd},
- {"flush", Tcl_FlushObjCmd},
- {"gets", Tcl_GetsObjCmd},
- {"pending", ChanPendingObjCmd}, /* TIP #287 */
- {"postevent", TclChanPostEventObjCmd}, /* TIP #219 */
- {"puts", Tcl_PutsObjCmd},
- {"read", Tcl_ReadObjCmd},
- {"seek", Tcl_SeekObjCmd},
- {"tell", Tcl_TellObjCmd},
- {"truncate", ChanTruncateObjCmd}, /* TIP #208 */
- {NULL}
+ {"blocked", Tcl_FblockedObjCmd, NULL},
+ {"close", Tcl_CloseObjCmd, NULL},
+ {"copy", Tcl_FcopyObjCmd, NULL},
+ {"create", TclChanCreateObjCmd, NULL}, /* TIP #219 */
+ {"eof", Tcl_EofObjCmd, NULL},
+ {"event", Tcl_FileEventObjCmd, NULL},
+ {"flush", Tcl_FlushObjCmd, NULL},
+ {"gets", Tcl_GetsObjCmd, NULL},
+ {"pending", ChanPendingObjCmd, NULL}, /* TIP #287 */
+ {"postevent", TclChanPostEventObjCmd, NULL}, /* TIP #219 */
+ {"puts", Tcl_PutsObjCmd, NULL},
+ {"read", Tcl_ReadObjCmd, NULL},
+ {"seek", Tcl_SeekObjCmd, NULL},
+ {"tell", Tcl_TellObjCmd, NULL},
+ {"truncate", ChanTruncateObjCmd, NULL}, /* TIP #208 */
+ {NULL,NULL, NULL}
};
- static const char *extras[] = {
+ static const char *const extras[] = {
"configure", "::fconfigure",
"names", "::file channels",
NULL
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 92251fe..dc28b97 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2762,6 +2762,7 @@ MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void);
MODULE_SCOPE double TclpWideClicksToNanoseconds(Tcl_WideInt clicks);
#endif
MODULE_SCOPE Tcl_Obj * TclDisassembleByteCodeObj(Tcl_Obj *objPtr);
+MODULE_SCOPE int TclUtfCasecmp(CONST char *cs, CONST char *ct);
/*
*----------------------------------------------------------------
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index fd4a222..99f3e4b 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -191,6 +191,91 @@ Tcl_WinTCharToUtf(
string, len, dsPtr);
}
+#if defined(TCL_WIDE_INT_IS_LONG)
+/* On Cygwin64, long is 64-bit while on Win64 long is 32-bit. Therefore
+ * we have to make sure that all stub entries on Cygwin64 follow the Win64
+ * signature. Tcl 9 must find a better solution, but that cannot be done
+ * without introducing a binary incompatibility.
+ */
+#define Tcl_DbNewLongObj ((Tcl_Obj*(*)(long,const char*,int))dbNewLongObj)
+static Tcl_Obj *dbNewLongObj(
+ int intValue,
+ const char *file,
+ int line
+) {
+#ifdef TCL_MEM_DEBUG
+ register Tcl_Obj *objPtr;
+
+ TclDbNewObj(objPtr, file, line);
+ objPtr->bytes = NULL;
+
+ objPtr->internalRep.longValue = (long) intValue;
+ objPtr->typePtr = &tclIntType;
+ return objPtr;
+#else
+ return Tcl_NewIntObj(intValue);
+#endif
+}
+#define Tcl_GetLongFromObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))Tcl_GetIntFromObj
+#define Tcl_NewLongObj (Tcl_Obj*(*)(long))Tcl_NewIntObj
+#define Tcl_SetLongObj (void(*)(Tcl_Obj*,long))Tcl_SetIntObj
+static int exprInt(Tcl_Interp *interp, const char *expr, int *ptr){
+ long longValue;
+ int result = Tcl_ExprLong(interp, expr, &longValue);
+ if (result == TCL_OK) {
+ if ((longValue >= -(long)(UINT_MAX))
+ && (longValue <= (long)(UINT_MAX))) {
+ *ptr = (int)longValue;
+ } else {
+ Tcl_SetResult(interp,
+ "integer value too large to represent as non-long integer",
+ TCL_STATIC);
+ result = TCL_ERROR;
+ }
+ }
+ return result;
+}
+#define Tcl_ExprLong (int(*)(Tcl_Interp*,const char*,long*))exprInt
+static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){
+ long longValue;
+ int result = Tcl_ExprLongObj(interp, expr, &longValue);
+ if (result == TCL_OK) {
+ if ((longValue >= -(long)(UINT_MAX))
+ && (longValue <= (long)(UINT_MAX))) {
+ *ptr = (int)longValue;
+ } else {
+ Tcl_SetResult(interp,
+ "integer value too large to represent as non-long integer",
+ TCL_STATIC);
+ result = TCL_ERROR;
+ }
+ }
+ return result;
+}
+#define Tcl_ExprLongObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))exprIntObj
+static int uniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){
+ return Tcl_UniCharNcmp(ucs, uct, (unsigned long)n);
+}
+#define Tcl_UniCharNcmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))uniCharNcmp
+static int utfNcmp(const char *s1, const char *s2, unsigned int n){
+ return Tcl_UtfNcmp(s1, s2, (unsigned long)n);
+}
+#define Tcl_UtfNcmp (int(*)(const char*,const char*,unsigned long))utfNcmp
+static int utfNcasecmp(const char *s1, const char *s2, unsigned int n){
+ return Tcl_UtfNcasecmp(s1, s2, (unsigned long)n);
+}
+#define Tcl_UtfNcasecmp (int(*)(const char*,const char*,unsigned long))utfNcasecmp
+static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){
+ return Tcl_UniCharNcasecmp(ucs, uct, (unsigned long)n);
+}
+#define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))uniCharNcasecmp
+static int formatInt(char *buffer, int n){
+ return TclFormatInt(buffer, (long)n);
+}
+#define TclFormatInt (int(*)(char *, long))formatInt
+
+#endif
+
#else /* UNIX and MAC */
# define TclpLocaltime_unix TclpLocaltime
# define TclpGmtime_unix TclpGmtime
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index d032cc6..f899779 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -292,7 +292,7 @@ Tcl_ThreadObjCmd(
return TCL_OK;
case THREAD_ID:
if (objc == 2) {
- Tcl_Obj *idObj = Tcl_NewLongObj((long) Tcl_GetCurrentThread());
+ Tcl_Obj *idObj = Tcl_NewWideIntObj((Tcl_WideInt)(size_t) Tcl_GetCurrentThread());
Tcl_SetObjResult(interp, idObj);
return TCL_OK;
@@ -301,24 +301,24 @@ Tcl_ThreadObjCmd(
return TCL_ERROR;
}
case THREAD_JOIN: {
- long id;
+ Tcl_WideInt id;
int result, status;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "id");
return TCL_ERROR;
}
- if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) {
+ if (Tcl_GetWideIntFromObj(interp, objv[2], &id) != TCL_OK) {
return TCL_ERROR;
}
- result = Tcl_JoinThread ((Tcl_ThreadId) id, &status);
+ result = Tcl_JoinThread ((Tcl_ThreadId)(size_t)id, &status);
if (result == TCL_OK) {
Tcl_SetIntObj (Tcl_GetObjResult (interp), status);
} else {
char buf [20];
- sprintf(buf, "%ld", id);
+ sprintf(buf, "%" TCL_LL_MODIFIER "d", id);
Tcl_AppendResult(interp, "cannot join thread ", buf, NULL);
}
return result;
@@ -330,7 +330,7 @@ Tcl_ThreadObjCmd(
}
return TclThreadList(interp);
case THREAD_SEND: {
- long id;
+ Tcl_WideInt id;
const char *script;
int wait, arg;
@@ -349,12 +349,12 @@ Tcl_ThreadObjCmd(
wait = 1;
arg = 2;
}
- if (Tcl_GetLongFromObj(interp, objv[arg], &id) != TCL_OK) {
+ if (Tcl_GetWideIntFromObj(interp, objv[arg], &id) != TCL_OK) {
return TCL_ERROR;
}
arg++;
script = Tcl_GetString(objv[arg]);
- return TclThreadSend(interp, (Tcl_ThreadId) id, script, wait);
+ return TclThreadSend(interp, (Tcl_ThreadId)(size_t)id, script, wait);
}
case THREAD_ERRORPROC: {
/*
@@ -434,7 +434,7 @@ TclCreateThread(
Tcl_ConditionWait(&ctrl.condWait, &threadMutex, NULL);
Tcl_MutexUnlock(&threadMutex);
Tcl_ConditionFinalize(&ctrl.condWait);
- Tcl_SetObjResult(interp, Tcl_NewLongObj((long)id));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)(size_t)id));
return TCL_OK;
}
@@ -560,7 +560,7 @@ ThreadErrorProc(
const char *errorInfo, *argv[3];
char *script;
char buf[TCL_DOUBLE_SPACE+1];
- sprintf(buf, "%ld", (long) Tcl_GetCurrentThread());
+ sprintf(buf, "%" TCL_LL_MODIFIER "d", (Tcl_WideInt)(size_t)Tcl_GetCurrentThread());
errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
if (errorProcString == NULL) {
@@ -677,7 +677,7 @@ TclThreadList(
Tcl_MutexLock(&threadMutex);
for (tsdPtr = threadList ; tsdPtr ; tsdPtr = tsdPtr->nextPtr) {
Tcl_ListObjAppendElement(interp, listPtr,
- Tcl_NewLongObj((long) tsdPtr->threadId));
+ Tcl_NewWideIntObj((Tcl_WideInt)(size_t)tsdPtr->threadId));
}
Tcl_MutexUnlock(&threadMutex);
Tcl_SetObjResult(interp, listPtr);
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index 83900e9..a122685 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -1105,6 +1105,46 @@ Tcl_UtfNcasecmp(
/*
*----------------------------------------------------------------------
*
+ * Tcl_UtfNcasecmp --
+ *
+ * Compare UTF chars of string cs to string ct case insensitively.
+ * Replacement for strcasecmp in Tcl core, in places where UTF-8 should
+ * be handled.
+ *
+ * Results:
+ * Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclUtfCasecmp(
+ CONST char *cs, /* UTF string to compare to ct. */
+ CONST char *ct) /* UTF string cs is compared to. */
+{
+ while (*cs && *ct) {
+ Tcl_UniChar ch1, ch2;
+
+ cs += TclUtfToUniChar(cs, &ch1);
+ ct += TclUtfToUniChar(ct, &ch2);
+ if (ch1 != ch2) {
+ ch1 = Tcl_UniCharToLower(ch1);
+ ch2 = Tcl_UniCharToLower(ch2);
+ if (ch1 != ch2) {
+ return ch1 - ch2;
+ }
+ }
+ }
+ return UCHAR(*cs) - UCHAR(*ct);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_UniCharToUpper --
*
* Compute the uppercase equivalent of the given Unicode character.
@@ -1514,7 +1554,9 @@ Tcl_UniCharIsSpace(
*/
if (((Tcl_UniChar) ch) < ((Tcl_UniChar) 0x80)) {
- return isspace(UCHAR(ch)); /* INTL: ISO space */
+ return TclIsSpaceProc(ch);
+ } else if ((Tcl_UniChar) ch == 0x180e) {
+ return 1;
} else {
return ((SPACE_BITS >> GetCategory(ch)) & 1);
}
diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl
index 5f0ba2e..cf3b9d7 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.5.1
+package provide msgcat 1.5.2
namespace eval msgcat {
namespace export mc mcload mclocale mcmax mcmset mcpreferences mcset \
@@ -541,8 +541,11 @@ proc msgcat::Init {} {
# 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:
+ # On Vista and later:
+ # HCU/Control Panel/Desktop : PreferredUILanguages is for language packs,
+ # HCU/Control Pannel/International : localName is the default locale.
+ #
+ # They contain 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)
@@ -550,23 +553,25 @@ proc msgcat::Init {} {
# 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 {![catch {registry get $key LocaleName} localeName]
- && [regexp {^([a-z]{2,3})(?:-([a-z]{4}))?(?:-([a-z]{2}))?(?:-.+)?$}\
- [string tolower $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
+ foreach key {{HKEY_CURRENT_USER\Control Panel\Desktop} {HKEY_CURRENT_USER\Control Panel\International}}\
+ value {PreferredUILanguages localeName} {
+ if {![catch {registry get $key $value} localeName]
+ && [regexp {^([a-z]{2,3})(?:-([a-z]{4}))?(?:-([a-z]{2}))?(?:-.+)?$}\
+ [string tolower $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
+ # then check value locale which contains a numerical language ID
if {[catch {
set locale [registry get $key "locale"]
}]} {
diff --git a/library/msgcat/pkgIndex.tcl b/library/msgcat/pkgIndex.tcl
index 3fdb25a..5fabfe3 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.5.1 [list source [file join $dir msgcat.tcl]]
+package ifneeded msgcat 1.5.2 [list source [file join $dir msgcat.tcl]]
diff --git a/library/platform/pkgIndex.tcl b/library/platform/pkgIndex.tcl
index b882e4f..23a3408 100644
--- a/library/platform/pkgIndex.tcl
+++ b/library/platform/pkgIndex.tcl
@@ -1,3 +1,3 @@
-package ifneeded platform 1.0.11 [list source [file join $dir platform.tcl]]
+package ifneeded platform 1.0.12 [list source [file join $dir platform.tcl]]
package ifneeded platform::shell 1.1.4 [list source [file join $dir shell.tcl]]
diff --git a/library/platform/platform.tcl b/library/platform/platform.tcl
index a1a728b..5698425 100644
--- a/library/platform/platform.tcl
+++ b/library/platform/platform.tcl
@@ -256,7 +256,7 @@ proc ::platform::LibcVersion {base _->_ vv} {
if {![catch {
set vdata [lindex [split [exec $libc] \n] 0]
}]} {
- regexp {version ([0-9]+(\.[0-9]+)*), by} $vdata -> v
+ regexp {version ([0-9]+(\.[0-9]+)*)} $vdata -> v
foreach {major minor} [split $v .] break
set v glibc${major}.${minor}
return 1
@@ -368,7 +368,7 @@ proc ::platform::patterns {id} {
# ### ### ### ######### ######### #########
## Ready
-package provide platform 1.0.11
+package provide platform 1.0.12
# ### ### ### ######### ######### #########
## Demo application
diff --git a/macosx/README b/macosx/README
index 80bed14..06e797e 100644
--- a/macosx/README
+++ b/macosx/README
@@ -20,8 +20,8 @@ before asking on the list, many questions have already been answered).
http://wiki.tcl.tk/_/ref?N=3753
http://wiki.tcl.tk/_/ref?N=8361
-- Please report bugs with Tcl or Tk on Mac OS X to the sourceforge bug trackers:
- http://tcl.sourceforge.net/
+- Please report bugs with Tcl on Mac OS X to the tracker:
+ http://core.tcl.tk/tcl/reportlist
2. Using Tcl on Mac OS X
------------------------
diff --git a/tests/cmdIL.test b/tests/cmdIL.test
index b387e71..6fab269 100644
--- a/tests/cmdIL.test
+++ b/tests/cmdIL.test
@@ -394,6 +394,15 @@ test cmdIL-4.34 {SortCompare procedure, -ascii option with -nocase option} {
test cmdIL-4.35 {SortCompare procedure, -ascii option with -nocase option} {
lsort -ascii -nocase {d E c B a D35 d300 100 20}
} {100 20 a B c d d300 D35 E}
+test cmdIL-4.36 {SortCompare procedure, UTF-8 with -nocase option} {
+ scan [lsort -ascii -nocase [list \u101 \u100]] %c%c%c
+} {257 32 256}
+test cmdIL-4.37 {SortCompare procedure, UTF-8 with -nocase option} {
+ scan [lsort -ascii -nocase [list a\u0000a a]] %c%c%c%c%c
+} {97 32 97 0 97}
+test cmdIL-4.38 {SortCompare procedure, UTF-8 with -nocase option} {
+ scan [lsort -ascii -nocase [list a a\u0000a]] %c%c%c%c%c
+} {97 32 97 0 97}
test cmdIL-5.1 {lsort with list style index} {
lsort -ascii -decreasing -index {0 1} {
diff --git a/tests/env.test b/tests/env.test
index c42e49d..ee13b7f 100644
--- a/tests/env.test
+++ b/tests/env.test
@@ -86,7 +86,7 @@ set printenvScript [makeFile {
SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
__CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM
- CommonProgramFiles ProgramFiles
+ CommonProgramFiles ProgramFiles CommonProgramW6432 ProgramW6432
} {
lrem names $name
}
@@ -118,7 +118,7 @@ foreach name [array names env] {
SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
SECURITYSESSIONID LANG WINDIR TERM
- CommonProgramFiles ProgramFiles
+ CONNOMPROGRAMFILES PROGRAMFILES COMMONPROGRAMW6432 PROGRAMW6432
}} {
unset env($name)
}
diff --git a/tests/httpd b/tests/httpd
index f810797..232e80a 100644
--- a/tests/httpd
+++ b/tests/httpd
@@ -40,7 +40,7 @@ proc httpdAccept {newsock ipaddr port} {
fconfigure $newsock -blocking 0 -translation {auto crlf}
httpd_log $newsock Connect $ipaddr $port
set data(ipaddr) $ipaddr
- fileevent $newsock readable [list httpdRead $newsock]
+ after 50 [list fileevent $newsock readable [list httpdRead $newsock]]
}
# read data from a client request
diff --git a/tests/utf.test b/tests/utf.test
index ad1e7b8..35c5f73 100644
--- a/tests/utf.test
+++ b/tests/utf.test
@@ -322,8 +322,8 @@ test utf-21.11 {TclUniCharIsControl} {
string is control \u00ad
} {1}
test utf-21.12 {unicode control char in regc_locale.c} {
- # [Bug 3464428]
- regexp {^[[:cntrl:]]$} \u00ad
+ # [Bug 3464428], [Bug a876646efe]
+ regexp {^[[:cntrl:]]*$} \u0000\u001f\u00ad
} {1}
test utf-22.1 {TclUniCharIsWordChar} {
diff --git a/tools/uniClass.tcl b/tools/uniClass.tcl
index 32b40e9..9b4819d 100644
--- a/tools/uniClass.tcl
+++ b/tools/uniClass.tcl
@@ -72,7 +72,7 @@ proc genTable {type} {
if {$i == ($last + 1)} {
set last $i
} else {
- if {$first > 0} {
+ if {$first >= 0} {
emitRange $first $last
}
set first $i
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 071cf94..34c7165 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -773,13 +773,13 @@ install-libraries: libraries $(INSTALL_TZDATA) install-msgs
do \
$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \
done;
- @echo "Installing package msgcat 1.5.1 as a Tcl Module";
- @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.5.1.tm;
+ @echo "Installing package msgcat 1.5.2 as a Tcl Module";
+ @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.5.2.tm;
@echo "Installing package tcltest 2.3.5 as a Tcl Module";
@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.5.tm;
- @echo "Installing package platform 1.0.11 as a Tcl Module";
- @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.11.tm;
+ @echo "Installing package platform 1.0.12 as a Tcl Module";
+ @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.12.tm;
@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
@$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform/shell-1.1.4.tm;
diff --git a/unix/README b/unix/README
index 87b151a..d8f1090 100644
--- a/unix/README
+++ b/unix/README
@@ -163,6 +163,7 @@ you'll see a much more substantial printout for each error. See the README
file in the "tests" directory for more information on the test suite. Note:
don't run the tests as superuser: this will cause several of them to fail. If
a test is failing consistently, please send us a bug report with as much
-detail as you can manage. Please use the online database at
- http://tcl.sourceforge.net/
+detail as you can manage to our tracker:
+
+ http://core.tcl.tk/tcl/reportlist
diff --git a/unix/configure b/unix/configure
index 65adb15..61c2247 100755
--- a/unix/configure
+++ b/unix/configure
@@ -7559,63 +7559,6 @@ fi
CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
- NetBSD-1.*|FreeBSD-[1-2].*)
- SHLIB_CFLAGS="-fPIC"
- SHLIB_LD="ld -Bshareable -x"
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS=""
- if test $doRpath = yes; then
-
- CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
- LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}'
-fi
-
- echo "$as_me:$LINENO: checking for ELF" >&5
-echo $ECHO_N "checking for ELF... $ECHO_C" >&6
-if test "${tcl_cv_ld_elf+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
-
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
-#ifdef __ELF__
- yes
-#endif
-
-_ACEOF
-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
- $EGREP "yes" >/dev/null 2>&1; then
- tcl_cv_ld_elf=yes
-else
- tcl_cv_ld_elf=no
-fi
-rm -f conftest*
-
-fi
-echo "$as_me:$LINENO: result: $tcl_cv_ld_elf" >&5
-echo "${ECHO_T}$tcl_cv_ld_elf" >&6
- if test $tcl_cv_ld_elf = yes; then
-
- SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so'
-
-else
-
- SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}'
-
-fi
-
-
- # Ancient FreeBSD doesn't handle version numbers with dots.
-
- UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
- TCL_LIB_VERSIONS_OK=nodots
- ;;
OpenBSD-*)
arch=`arch -s`
case "$arch" in
@@ -7701,9 +7644,8 @@ fi
UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
TCL_LIB_VERSIONS_OK=nodots
;;
- NetBSD-*|FreeBSD-[3-4].*)
- # FreeBSD 3.* and greater have ELF.
- # NetBSD 2.* has ELF and can use 'cc -shared' to build shared libs
+ NetBSD-*)
+ # NetBSD has ELF and can use 'cc -shared' to build shared libs
SHLIB_CFLAGS="-fPIC"
SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}'
SHLIB_SUFFIX=".so"
@@ -7738,7 +7680,7 @@ fi
# This configuration from FreeBSD Ports.
SHLIB_CFLAGS="-fPIC"
SHLIB_LD="${CC} -shared"
- TCL_SHLIB_LD_EXTRAS="-soname \$@"
+ TCL_SHLIB_LD_EXTRAS="-Wl,-soname,\$@"
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
@@ -7746,7 +7688,7 @@ fi
if test $doRpath = yes; then
CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
- LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
fi
if test "${TCL_THREADS}" = "1"; then
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index 668fa2f..850e940 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -1481,32 +1481,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
- NetBSD-1.*|FreeBSD-[[1-2]].*)
- SHLIB_CFLAGS="-fPIC"
- SHLIB_LD="ld -Bshareable -x"
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS=""
- AS_IF([test $doRpath = yes], [
- CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
- LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}'])
- AC_CACHE_CHECK([for ELF], tcl_cv_ld_elf, [
- AC_EGREP_CPP(yes, [
-#ifdef __ELF__
- yes
-#endif
- ], tcl_cv_ld_elf=yes, tcl_cv_ld_elf=no)])
- AS_IF([test $tcl_cv_ld_elf = yes], [
- SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so'
- ], [
- SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}'
- ])
-
- # Ancient FreeBSD doesn't handle version numbers with dots.
-
- UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
- TCL_LIB_VERSIONS_OK=nodots
- ;;
OpenBSD-*)
arch=`arch -s`
case "$arch" in
@@ -1558,9 +1532,8 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
TCL_LIB_VERSIONS_OK=nodots
;;
- NetBSD-*|FreeBSD-[[3-4]].*)
- # FreeBSD 3.* and greater have ELF.
- # NetBSD 2.* has ELF and can use 'cc -shared' to build shared libs
+ NetBSD-*)
+ # NetBSD has ELF and can use 'cc -shared' to build shared libs
SHLIB_CFLAGS="-fPIC"
SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}'
SHLIB_SUFFIX=".so"
@@ -1589,14 +1562,14 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
# This configuration from FreeBSD Ports.
SHLIB_CFLAGS="-fPIC"
SHLIB_LD="${CC} -shared"
- TCL_SHLIB_LD_EXTRAS="-soname \$[@]"
+ TCL_SHLIB_LD_EXTRAS="-Wl,-soname,\$[@]"
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
LDFLAGS=""
AS_IF([test $doRpath = yes], [
CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
- LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}'])
+ LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'])
AS_IF([test "${TCL_THREADS}" = "1"], [
# The -pthread needs to go in the LDFLAGS, not LIBS
LIBS=`echo $LIBS | sed s/-pthread//`
diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h
index 7cfeec0..08a4f44 100644
--- a/unix/tclUnixPort.h
+++ b/unix/tclUnixPort.h
@@ -95,9 +95,11 @@ typedef off_t Tcl_SeekOffset;
# define USE_PUTENV 1
# define USE_PUTENV_FOR_UNSET 1
/* On Cygwin, the environment is imported from the Cygwin DLL. */
+#ifndef __x86_64__
# define environ __cygwin_environ
-# define timezone _timezone
extern char **__cygwin_environ;
+#endif
+# define timezone _timezone
extern int TclOSstat(const char *name, void *statBuf);
extern int TclOSlstat(const char *name, void *statBuf);
#elif defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__)
diff --git a/win/Makefile.in b/win/Makefile.in
index fec5ff6..235313f 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -649,12 +649,12 @@ install-libraries: libraries install-tzdata install-msgs
do \
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
done;
- @echo "Installing package msgcat 1.5.1 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.5.1.tm;
+ @echo "Installing package msgcat 1.5.2 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.5.2.tm;
@echo "Installing package tcltest 2.3.5 as a Tcl Module";
@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.5.tm;
- @echo "Installing package platform 1.0.11 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.11.tm;
+ @echo "Installing package platform 1.0.12 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.12.tm;
@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
@$(COPY) $(ROOT_DIR)/library/platform/shell.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform/shell-1.1.4.tm;
@echo "Installing encodings";
diff --git a/win/README b/win/README
index 1cb04f3..8288e3d 100644
--- a/win/README
+++ b/win/README
@@ -91,9 +91,9 @@ Note: Tcl no longer provides support for Win32s.
This distribution contains an extensive test suite for Tcl. Some of the
tests are timing dependent and will fail from time to time. If a test is
failing consistently, please send us a bug report with as much detail as
-you can manage. Please use the online database at
+you can manage to our tracker:
- http://tcl.sourceforge.net/
+ http://core.tcl.tk/tcl/reportlist
In order to run the test suite, you build the "test" target using the
appropriate makefile for your compiler.
diff --git a/win/tclWinPort.h b/win/tclWinPort.h
index f58014c..ec9e867 100644
--- a/win/tclWinPort.h
+++ b/win/tclWinPort.h
@@ -51,6 +51,7 @@ typedef DWORD_PTR * PDWORD_PTR;
*---------------------------------------------------------------------------
*/
+#include <time.h>
#include <io.h>
#include <stdio.h>
#include <stdlib.h>
@@ -63,11 +64,9 @@ typedef DWORD_PTR * PDWORD_PTR;
#include <string.h>
#include <limits.h>
-#ifndef strncasecmp
-# define strncasecmp strnicmp
-#endif
-#ifndef strcasecmp
-# define strcasecmp stricmp
+#ifndef __GNUC__
+# define strncasecmp _strnicmp
+# define strcasecmp _stricmp
#endif
/*
@@ -85,8 +84,6 @@ typedef DWORD_PTR * PDWORD_PTR;
# endif /* __BORLANDC__ */
#endif /* __MWERKS__ */
-#include <time.h>
-
/*
* Define EINPROGRESS in terms of WSAEINPROGRESS.
*/
@@ -351,9 +348,9 @@ typedef DWORD_PTR * PDWORD_PTR;
#if defined(_MSC_VER) || defined(__MINGW32__)
# define environ _environ
-# if defined(_MSC_VER) && (_MSC_VER < 1600)
+# if defined(_MSC_VER) && (_MSC_VER < 1600)
# define hypot _hypot
-# endif
+# endif
# define exception _exception
# undef EDEADLOCK
# if defined(__MINGW32__) && !defined(__MSVCRT__)
@@ -382,8 +379,10 @@ typedef DWORD_PTR * PDWORD_PTR;
* including the *printf family and others. Tell it to shut up.
* (_MSC_VER is 1200 for VC6, 1300 or 1310 for vc7.net, 1400 for 8.0)
*/
-#if _MSC_VER >= 1400
-#pragma warning(disable:4996)
+#if defined(_MSC_VER) && (_MSC_VER >= 1400)
+# pragma warning(disable:4244)
+# pragma warning(disable:4267)
+# pragma warning(disable:4996)
#endif
diff --git a/win/tclWinTime.c b/win/tclWinTime.c
index f34884a..0163723 100644
--- a/win/tclWinTime.c
+++ b/win/tclWinTime.c
@@ -309,7 +309,7 @@ NativeGetTime(
Tcl_Time *timePtr,
ClientData clientData)
{
- struct timeb t;
+ struct _timeb t;
int useFtime = 1; /* Flag == TRUE if we need to fall back on
* ftime rather than using the perf counter. */
@@ -475,7 +475,7 @@ NativeGetTime(
* High resolution timer is not available. Just use ftime.
*/
- ftime(&t);
+ _ftime(&t);
timePtr->sec = (long)t.time;
timePtr->usec = t.millitm * 1000;
}