diff options
55 files changed, 1171 insertions, 933 deletions
@@ -1,3 +1,89 @@ +2012-05-22 Jan Nijtmans <nijtmans@users.sf.net> + + * tools/genStubs.tcl: Let cygwin share stub table with win32 + * win/Makefile.in: Don't hardcode dde and reg dll version numbers + * win/tclWinSock.c: implement TclpInetNtoa for win32 + * generic/tclInt.decls: Revert most of [fcc5957e59], since when + we let cygwin share the win32 stub table this is no longer necessary + * generic/tcl*Decls.h: re-generated + +2012-05-21 Don Porter <dgp@users.sourceforge.net> + + * generic/tclFileName.c: When using Tcl_SetObjLength() calls to grow + * generic/tclPathObj.c: and shrink the objPtr->bytes buffer, care must be + taken that the value cannot possibly become pure Unicode. Calling + Tcl_AppendToObj() has the possibility of making such a conversion. Bug + found while valgrinding the trunk. + +2012-05-17 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclCmdMZ.c (Tcl_SwitchObjCmd): [Bug 3106532]: Corrected + resulting indexes from -indexvar option to be usable with [string + range]; this was always the intention (and is consistent with [regexp + -indices] too). + ***POTENTIAL INCOMPATIBILITY*** + Uses of [switch -regexp -indexvar] that previously compensated for the + wrong offsets (by subtracting 1 from the end indices) now do not need + to do so as the value is correct. + + * library/safe.tcl (safe::InterpInit): Ensure that the module path is + constructed in the correct order. + (safe::AliasGlob): [Bug 2964715]: More extensive handling of what + globbing is required to support package loading. + + * doc/expr.n: [Bug 3525462]: Corrected statement about what happens + when comparing "0y" and "0x12"; the previously documented behavior was + actually a subtle bug (now long-corrected). + +2012-05-13 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tclWinDde.c: Protect against receiving strings without ending \0, + as external applications (or Tcl with TIP #106) could generate that. + +2012-05-10 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tclWinDde.c: [Bug 473946]: special characters not correctly sent + * library/dde/pkgIndex.tcl Increase version to 1.3.3 + +2012-05-02 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/configure.in: Better detection and implementation for cpuid + * generic/configure: instruction on Intel-derived processors, both + * generic/tclUnixCompat.c: 32-bit and 64-bit. + * generic/tclTest.c: Move cpuid testcase from win-specific to generic + * win/tclWinTest.c: tests, as it should work on all Intel-related + * tests/platform.test: platforms now + +2012-04-27 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tclPort.h: Move CYGWIN-specific stuff from tclPort.h to + * generic/tclEnv.c: tclUnixPort.h, where it belongs. + * unix/tclUnixPort.h: + * unix/tclUnixFile.c: + +2012-04-27 Donal K. Fellows <dkf@users.sf.net> + + * library/init.tcl (auto_execok): Allow shell builtins to be detected + even if they are upper-cased. + +2012-04-26 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tclStubInit.c: get rid of _ANSI_ARGS_ + * generic/tclIntPlatDecls.h + * unix/tclUnixPort.h + * unix/tclAppInit.c + * win/tclAppInit.c + +2012-04-24 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tclInt.decls: [Bug 3508771] load tclreg.dll in cygwin tclsh + * generic/tclIntPlatDecls.h: Implement TclWinGetSockOpt, TclWinGetServByName + * generic/tclStubInit.c: and TclWinCPUID for Cygwin + * generic/tclUnixCompat.c: + * unix/configure.in: + * unix/configure: + * unix/tclUnixCompat.c: + 2012-04-18 Kevin B. Kenny <kennykb@acm.org> * library/tzdata/Africa/Casablanca: @@ -62,7 +148,7 @@ * generic/tclInt.decls: [Bug 3508771] load tclreg.dll in cygwin tclsh * generic/tclIntPlatDecls.h: Implement TclWinConvertError, TclWinConvertWSAError, - * generic/tclStubInit.c: and various more win32-specific internal functions for + * generic/tclStubInit.c: and various more win32-specific internal functions for * unix/Makefile.in: Cygwin, so win32 extensions using those can be * unix/tcl.m4: loaded in the cygwin version of tclsh. * unix/configure: @@ -82,7 +168,7 @@ * generic/tcl.decls: [Bug 3508771] load tclreg.dll in cygwin tclsh * generic/tclInt.decls: Implement TclWinGetPlatformId, Tcl_WinUtfToTChar, - * generic/tclIntPlatDecls.h: Tcl_WinTCharToUtf (and a dummy TclWinCPUID) for + * generic/tclIntPlatDecls.h: Tcl_WinTCharToUtf (and a dummy TclWinCPUID) for * generic/tclPlatDecls.h: Cygwin, so win32 extensions using those can be * generic/tclStubInit.c: loaded in the cygwin version of tclsh. * unix/tclUnixCompat.c: @@ -213,7 +299,7 @@ 2012-01-22 Jan Nijtmans <nijtmans@users.sf.net> - * tools/uniClass.tcl: [Frq 3473670]: Various Unicode-related + * tools/uniClass.tcl: [Frq 3473670]: Various Unicode-related * tools/uniParse.tcl: speedups/robustness. Enhanced tools to * generic/tclUniData.c: be able to handle characters > 0xffff * generic/tclUtf.c: Done in all branches in order to simplify @@ -698,7 +784,7 @@ * generic/tclListObj.c: of a boolean var, where the caller can be told * generic/tclParse.c: whether or not the parsed list element was * generic/tclUtil.c: enclosed in braces. In practice, no callers - really care about that. What the callers really want to know is + really care about that. What the callers really want to know is whether the list element value exists as a literal substring of the string being parsed, or whether a call to TclCopyAndCollpase() is needed to produce the list element value. Now the final argument @@ -736,7 +822,7 @@ * generic/tclStrToD.c: * generic/tclUtf.c: * unix/tclUnixFile.c: - + 2011-04-27 Don Porter <dgp@users.sourceforge.net> * generic/tclListObj.c: FreeListInternalRep() cleanup. @@ -1199,7 +1285,7 @@ 2010-09-23 Don Porter <dgp@users.sourceforge.net> - * generic/tclCmdAH.c: Fix cases where value returned by + * generic/tclCmdAH.c: Fix cases where value returned by * generic/tclEvent.c: Tcl_GetReturnOptions() was leaked. * generic/tclMain.c: Thanks to Jeff Hobbs for discovery of the anti-pattern to seek and destroy. @@ -1498,7 +1584,7 @@ * library/platform/platform.tcl: Fix cpu name for Solaris/Intel 64bit. * library/platform/pkgIndex.tcl: Package updated to version 1.0.8. - * unix/Makefile.in: + * unix/Makefile.in: * win/Makefile.in: 2010-04-30 Don Porter <dgp@users.sourceforge.net> @@ -1534,7 +1620,7 @@ * library/tzdata/Pacific/Apia: * library/tzdata/Pacific/Easter: * library/tzdata/Pacific/Fiji: Olson's tzdata2010i. - + 2010-04-19 Jan Nijtmans <nijtmans@users.sf.net> * win/tclWinPort.h: [Patch 2986105]: Conditionally defining @@ -1870,9 +1956,9 @@ 2009-11-27 Donal K. Fellows <dkf@users.sf.net> - * doc/BoolObj.3, doc/CrtChannel.3, doc/DictObj.3, doc/DoubleObj.3: - * doc/Ensemble.3, doc/Environment.3, doc/FileSystem.3, doc/Hash.3: - * doc/IntObj.3, doc/Limit.3, doc/ObjectType.3, doc/PkgRequire.3: + * doc/BoolObj.3, doc/CrtChannel.3, doc/DictObj.3, doc/DoubleObj.3: + * doc/Ensemble.3, doc/Environment.3, doc/FileSystem.3, doc/Hash.3: + * doc/IntObj.3, doc/Limit.3, doc/ObjectType.3, doc/PkgRequire.3: * doc/SetChanErr.3, doc/SetResult.3: [Patch 2903921]: Many small spelling fixes from Larry Virden. @@ -1888,7 +1974,7 @@ * generic/tclEncoding.c: Fix [Bug 2891556] and improve test to detect * tests/decoding.test: similar manifestations in the future. - + 2009-11-12 Don Porter <dgp@users.sourceforge.net> *** 8.5.8 TAGGED FOR RELEASE *** @@ -1917,7 +2003,7 @@ * library/http/http.tcl: [Bug 2891171]: Update the URL syntax check to RFC 3986 compliance on the subject of non-encoded question mark characters. - + * library/http/pkgIndex.tcl: Bump to http 2.7.5 to avoid any * unix/Makefile.in: confusion with snapshot "releases" * win/Makefile.in: that might be in ActiveTcl, etc. @@ -1943,7 +2029,7 @@ 2009-11-09 Don Porter <dgp@users.sourceforge.net> - * generic/tclBasic.c (TclEvalObjEx): Plug memory leak in + * generic/tclBasic.c (TclEvalObjEx): Plug memory leak in TCL_EVAL_DIRECT evaluation. * tests/info.test: Resolve ambiguous resolution of variable "res". @@ -1972,7 +2058,7 @@ subdirectories. 2009-11-03 Kevin B. Kenny <kennykb@acm.org> - + * library/tzdata/Asia/Novokuznetsk: New tzdata locale for Kemerovo oblast', which now keeps Novosibirsk time and not Kranoyarsk time. * library/tzdata/Asia/Damascus: Syrian DST changes. @@ -298,6 +298,7 @@ returns \fB4.0\fR, not \fB4\fR. String values may be used as operands of the comparison operators, although the expression evaluator tries to do comparisons as integer or floating-point when it can, +i.e., when all arguments to the operator allow numeric interpretations, except in the case of the \fBeq\fR and \fBne\fR operators. If one of the operands of a comparison is a string and the other has a numeric value, a canonical string representation of the numeric @@ -308,11 +309,10 @@ is that produced by the \fB%g\fR format specifier of Tcl's \fBformat\fR command. For example, the commands .CS \fBexpr {"0x03" > "2"}\fR -\fBexpr {"0y" < "0x12"}\fR +\fBexpr {"0y" > "0x12"}\fR .CE both return 1. The first comparison is done using integer -comparison, and the second is done using string comparison after -the second operand is converted to the string \fB18\fR. +comparison, and the second is done using string comparison. Because of Tcl's tendency to treat values as numbers whenever possible, it is not generally a good idea to use operators like \fB==\fR when you really want string comparison and the values of the diff --git a/generic/tcl.decls b/generic/tcl.decls index 903669d..256701d 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -51,7 +51,7 @@ declare 6 { char *Tcl_DbCkalloc(unsigned int size, const char *file, int line) } declare 7 { - int Tcl_DbCkfree(char *ptr, const char *file, int line) + void Tcl_DbCkfree(char *ptr, const char *file, int line) } declare 8 { char *Tcl_DbCkrealloc(char *ptr, unsigned int size, @@ -2135,12 +2135,12 @@ declare 1 win { ################################ # Mac OS X specific functions -declare 0 {unix macosx} { +declare 0 macosx { int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath) } -declare 1 {unix macosx} { +declare 1 macosx { int Tcl_MacOSXOpenVersionedBundleResources(Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath) @@ -2154,6 +2154,14 @@ export { void Tcl_Main(int argc, char **argv, Tcl_AppInitProc *appInitProc) } export { + const char *Tcl_InitStubs(Tcl_Interp *interp, const char *version, + int exact) +} +export { + const char *TclTomMathInitializeStubs(Tcl_Interp* interp, + const char* version, int epoch, int revision) +} +export { const char *Tcl_PkgInitStubsCheck(Tcl_Interp *interp, const char *version, int exact) } diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index c374ce5..5c0432d 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -583,7 +583,7 @@ Tcl_AttemptDbCkalloc( *---------------------------------------------------------------------- */ -int +void Tcl_DbCkfree( char *ptr, CONST char *file, @@ -592,7 +592,7 @@ Tcl_DbCkfree( struct mem_header *memp; if (ptr == NULL) { - return 0; + return; } /* @@ -646,8 +646,6 @@ Tcl_DbCkfree( } TclpFree((char *) memp); Tcl_MutexUnlock(ckallocMutexPtr); - - return 0; } /* @@ -1219,14 +1217,13 @@ Tcl_Free( TclpFree(ptr); } -int +void Tcl_DbCkfree( char *ptr, CONST char *file, int line) { TclpFree(ptr); - return 0; } /* diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 531e2b1..0ad77aa 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -3679,8 +3679,12 @@ Tcl_SwitchObjCmd( if (indexVarObj != NULL) { Tcl_Obj *rangeObjAry[2]; - rangeObjAry[0] = Tcl_NewLongObj(info.matches[j].start); - rangeObjAry[1] = Tcl_NewLongObj(info.matches[j].end); + if (info.matches[j].end > 0) { + rangeObjAry[0] = Tcl_NewLongObj(info.matches[j].start); + rangeObjAry[1] = Tcl_NewLongObj(info.matches[j].end-1); + } else { + rangeObjAry[0] = rangeObjAry[1] = Tcl_NewIntObj(-1); + } /* * Never fails; the object is always clean at this point. diff --git a/generic/tclDate.c b/generic/tclDate.c index b77c7fd..59da2ea 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -2299,7 +2299,7 @@ MODULE_SCOPE int yynerrs; * Month and day table. */ -static TABLE MonthDayTable[] = { +static const TABLE MonthDayTable[] = { { "january", tMONTH, 1 }, { "february", tMONTH, 2 }, { "march", tMONTH, 3 }, @@ -2331,7 +2331,7 @@ static TABLE MonthDayTable[] = { * Time units table. */ -static TABLE UnitsTable[] = { +static const TABLE UnitsTable[] = { { "year", tMONTH_UNIT, 12 }, { "month", tMONTH_UNIT, 1 }, { "fortnight", tDAY_UNIT, 14 }, @@ -2349,7 +2349,7 @@ static TABLE UnitsTable[] = { * Assorted relative-time words. */ -static TABLE OtherTable[] = { +static const TABLE OtherTable[] = { { "tomorrow", tDAY_UNIT, 1 }, { "yesterday", tDAY_UNIT, -1 }, { "today", tDAY_UNIT, 0 }, @@ -2382,7 +2382,7 @@ static TABLE OtherTable[] = { * point constants to work around an SGI compiler bug). */ -static TABLE TimezoneTable[] = { +static const TABLE TimezoneTable[] = { { "gmt", tZONE, HOUR( 0) }, /* Greenwich Mean */ { "ut", tZONE, HOUR( 0) }, /* Universal (Coordinated) */ { "utc", tZONE, HOUR( 0) }, @@ -2467,7 +2467,7 @@ static TABLE TimezoneTable[] = { * Military timezone table. */ -static TABLE MilitaryTable[] = { +static const TABLE MilitaryTable[] = { { "a", tZONE, -HOUR( 1) }, { "b", tZONE, -HOUR( 2) }, { "c", tZONE, -HOUR( 3) }, @@ -2560,7 +2560,7 @@ LookupWord( { register char *p; register char *q; - register TABLE *tp; + register const TABLE *tp; int i, abbrev; /* diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 4517d01..424024d 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -78,7 +78,7 @@ EXTERN char * Tcl_DbCkalloc(unsigned int size, CONST char *file, #ifndef Tcl_DbCkfree_TCL_DECLARED #define Tcl_DbCkfree_TCL_DECLARED /* 7 */ -EXTERN int Tcl_DbCkfree(char *ptr, CONST char *file, int line); +EXTERN void Tcl_DbCkfree(char *ptr, CONST char *file, int line); #endif #ifndef Tcl_DbCkrealloc_TCL_DECLARED #define Tcl_DbCkrealloc_TCL_DECLARED @@ -86,7 +86,7 @@ EXTERN int Tcl_DbCkfree(char *ptr, CONST char *file, int line); EXTERN char * Tcl_DbCkrealloc(char *ptr, unsigned int size, CONST char *file, int line); #endif -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ +#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ #ifndef Tcl_CreateFileHandler_TCL_DECLARED #define Tcl_CreateFileHandler_TCL_DECLARED /* 9 */ @@ -102,7 +102,7 @@ EXTERN void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, ClientData clientData); #endif #endif /* MACOSX */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ +#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ #ifndef Tcl_DeleteFileHandler_TCL_DECLARED #define Tcl_DeleteFileHandler_TCL_DECLARED /* 10 */ @@ -1013,7 +1013,7 @@ EXTERN CONST char * Tcl_GetNameOfExecutable(void); /* 166 */ EXTERN Tcl_Obj * Tcl_GetObjResult(Tcl_Interp *interp); #endif -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ +#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ #ifndef Tcl_GetOpenFile_TCL_DECLARED #define Tcl_GetOpenFile_TCL_DECLARED /* 167 */ @@ -3426,21 +3426,21 @@ typedef struct TclStubs { void (*tcl_Free) (char *ptr); /* 4 */ char * (*tcl_Realloc) (char *ptr, unsigned int size); /* 5 */ char * (*tcl_DbCkalloc) (unsigned int size, CONST char *file, int line); /* 6 */ - int (*tcl_DbCkfree) (char *ptr, CONST char *file, int line); /* 7 */ + void (*tcl_DbCkfree) (char *ptr, CONST char *file, int line); /* 7 */ char * (*tcl_DbCkrealloc) (char *ptr, unsigned int size, CONST char *file, int line); /* 8 */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ +#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */ #endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ VOID *reserved9; #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */ #endif /* MACOSX */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ +#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ void (*tcl_DeleteFileHandler) (int fd); /* 10 */ #endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ VOID *reserved10; #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ @@ -3602,10 +3602,10 @@ typedef struct TclStubs { Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */ CONST char * (*tcl_GetNameOfExecutable) (void); /* 165 */ Tcl_Obj * (*tcl_GetObjResult) (Tcl_Interp *interp); /* 166 */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ +#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ int (*tcl_GetOpenFile) (Tcl_Interp *interp, CONST char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */ #endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ VOID *reserved167; #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ @@ -4075,7 +4075,7 @@ extern TclStubs *tclStubsPtr; #define Tcl_DbCkrealloc \ (tclStubsPtr->tcl_DbCkrealloc) /* 8 */ #endif -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ +#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ #ifndef Tcl_CreateFileHandler #define Tcl_CreateFileHandler \ (tclStubsPtr->tcl_CreateFileHandler) /* 9 */ @@ -4087,7 +4087,7 @@ extern TclStubs *tclStubsPtr; (tclStubsPtr->tcl_CreateFileHandler) /* 9 */ #endif #endif /* MACOSX */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ +#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ #ifndef Tcl_DeleteFileHandler #define Tcl_DeleteFileHandler \ (tclStubsPtr->tcl_DeleteFileHandler) /* 10 */ @@ -4723,7 +4723,7 @@ extern TclStubs *tclStubsPtr; #define Tcl_GetObjResult \ (tclStubsPtr->tcl_GetObjResult) /* 166 */ #endif -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ +#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ #ifndef Tcl_GetOpenFile #define Tcl_GetOpenFile \ (tclStubsPtr->tcl_GetOpenFile) /* 167 */ diff --git a/generic/tclEnv.c b/generic/tclEnv.c index 24fa106..bcc0ff1 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -696,6 +696,7 @@ TclFinalizeEnvironment(void) * fork) and the Windows environment (in case the application TCL code calls * exec, which calls the Windows CreateProcess function). */ +DLLIMPORT extern void __stdcall SetEnvironmentVariableA(const char*, const char *); static void TclCygwinPutenv( diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 8d97392..f2efa0f 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -116,7 +116,7 @@ long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 }; */ typedef struct { - char *name; /* Name of function. */ + const char *name; /* Name of function. */ int numArgs; /* Number of arguments for function. */ } BuiltinFunc; @@ -126,7 +126,7 @@ typedef struct { * operand byte. */ -static BuiltinFunc tclBuiltinFuncTable[] = { +static const BuiltinFunc tclBuiltinFuncTable[] = { {"acos", 1}, {"asin", 1}, {"atan", 1}, diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 1fca08b..4c57256 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -857,7 +857,7 @@ TclpNativeJoinPath( if (length > 0 && (start[length-1] != '/')) { Tcl_AppendToObj(prefix, "/", 1); - length++; + Tcl_GetStringFromObj(prefix, &length); } needsSep = 0; @@ -893,7 +893,7 @@ TclpNativeJoinPath( if ((length > 0) && (start[length-1] != '/') && (start[length-1] != ':')) { Tcl_AppendToObj(prefix, "/", 1); - length++; + Tcl_GetStringFromObj(prefix, &length); } needsSep = 0; diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index e22e40c..551b1ed 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -510,7 +510,7 @@ MODULE_SCOPE int yynerrs; * Month and day table. */ -static TABLE MonthDayTable[] = { +static const TABLE MonthDayTable[] = { { "january", tMONTH, 1 }, { "february", tMONTH, 2 }, { "march", tMONTH, 3 }, @@ -542,7 +542,7 @@ static TABLE MonthDayTable[] = { * Time units table. */ -static TABLE UnitsTable[] = { +static const TABLE UnitsTable[] = { { "year", tMONTH_UNIT, 12 }, { "month", tMONTH_UNIT, 1 }, { "fortnight", tDAY_UNIT, 14 }, @@ -560,7 +560,7 @@ static TABLE UnitsTable[] = { * Assorted relative-time words. */ -static TABLE OtherTable[] = { +static const TABLE OtherTable[] = { { "tomorrow", tDAY_UNIT, 1 }, { "yesterday", tDAY_UNIT, -1 }, { "today", tDAY_UNIT, 0 }, @@ -593,7 +593,7 @@ static TABLE OtherTable[] = { * point constants to work around an SGI compiler bug). */ -static TABLE TimezoneTable[] = { +static const TABLE TimezoneTable[] = { { "gmt", tZONE, HOUR( 0) }, /* Greenwich Mean */ { "ut", tZONE, HOUR( 0) }, /* Universal (Coordinated) */ { "utc", tZONE, HOUR( 0) }, @@ -678,7 +678,7 @@ static TABLE TimezoneTable[] = { * Military timezone table. */ -static TABLE MilitaryTable[] = { +static const TABLE MilitaryTable[] = { { "a", tZONE, -HOUR( 1) }, { "b", tZONE, -HOUR( 2) }, { "c", tZONE, -HOUR( 3) }, @@ -771,7 +771,7 @@ LookupWord( { register char *p; register char *q; - register TABLE *tp; + register const TABLE *tp; int i, abbrev; /* diff --git a/generic/tclIO.c b/generic/tclIO.c index 0f01baa..b9fa18d 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -8401,7 +8401,7 @@ Tcl_FileEventObjCmd( int modeIndex; /* Index of mode argument. */ int mask; static const char *modeOptions[] = {"readable", "writable", NULL}; - static int maskArray[] = {TCL_READABLE, TCL_WRITABLE}; + static CONST int maskArray[] = {TCL_READABLE, TCL_WRITABLE}; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?"); diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 0c05cbf..21dcd71 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -518,7 +518,7 @@ Tcl_SeekObjCmd( static const char *originOptions[] = { "start", "current", "end", NULL }; - static int modeArray[] = {SEEK_SET, SEEK_CUR, SEEK_END}; + static CONST int modeArray[] = {SEEK_SET, SEEK_CUR, SEEK_END}; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 1, objv, "channelId offset ?origin?"); diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c index 5dae459..eed21fb 100644 --- a/generic/tclIOGT.c +++ b/generic/tclIOGT.c @@ -133,7 +133,7 @@ static Tcl_ChannelType transformChannelType = { TransformNotifyProc, /* Handling of events bubbling up. */ TransformWideSeekProc, /* Wide seek proc. */ NULL, /* Thread action. */ - NULL, /* Truncate. */ + NULL /* Truncate. */ }; /* diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c index e259676..df7a13a 100644 --- a/generic/tclIOSock.c +++ b/generic/tclIOSock.c @@ -82,8 +82,8 @@ TclSockGetPort( */ #undef TclSockMinimumBuffers -#ifndef _WIN32 -# define SOCKET size_t +#if !defined(_WIN32) && !defined(__CYGWIN__) +# define SOCKET int #endif int diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 859f491..694d271 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -126,8 +126,8 @@ declare 25 { # } # Removed in 8.5 #declare 27 { -# int TclGetDate(char *p, Tcl_WideInt now, long zone, -# Tcl_WideInt *timePtr) +# int TclGetDate(char *p, unsigned long now, long zone, +# unsigned long *timePtr) #} declare 28 { Tcl_Channel TclpGetDefaultStdChannel(int type) @@ -187,7 +187,7 @@ declare 42 { } # Removed in Tcl 8.5a2 #declare 43 { -# int TclGlobalInvoke(Tcl_Interp *interp, int argc, const char **argv, +# int TclGlobalInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv, # int flags) #} declare 44 { @@ -222,7 +222,7 @@ declare 51 { } # Removed in Tcl 8.5a2 #declare 52 { -# int TclInvoke(Tcl_Interp *interp, int argc, const char **argv, +# int TclInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv, # int flags) #} declare 53 { @@ -421,9 +421,6 @@ declare 103 { declare 104 { int TclSockMinimumBuffersOld(int sock, int size) } -declare 110 {unix win} { - int TclSockMinimumBuffers(void *sock, int size) -} # Replaced by Tcl_FSStat in 8.4: #declare 105 { # int TclStat(const char *path, Tcl_StatBuf *buf) @@ -440,6 +437,9 @@ declare 108 { declare 109 { int TclUpdateReturnInfo(Interp *iPtr) } +declare 110 { + int TclSockMinimumBuffers(void *sock, int size) +} # Removed in 8.1: # declare 110 { # char *TclWordEnd(char *start, char *lastChar, int nested, int *semiPtr) @@ -732,6 +732,16 @@ declare 179 { Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr) } +# REMOVED +# Allocate lists without copying arrays +# declare 180 { +# Tcl_Obj *TclNewListObjDirect(int objc, Tcl_Obj **objv) +# } +#declare 181 { +# Tcl_Obj *TclDbNewListObjDirect(int objc, Tcl_Obj **objv, +# const char *file, int line) +#} + # TclpGmtime and TclpLocaltime promoted to the generic interface from unix declare 182 { @@ -963,23 +973,31 @@ declare 3 win { declare 4 win { HINSTANCE TclWinGetTclInstance(void) } +# new for 8.4.20+/8.5.12+ Cygwin only +declare 5 win { + int TclUnixWaitForFile(int fd, int mask, int timeout) +} # Removed in 8.1: # declare 5 win { # HINSTANCE TclWinLoadLibrary(char *name) # } declare 6 win { - u_short TclWinNToHS(u_short ns) + unsigned short TclWinNToHS(unsigned short ns) } declare 7 win { int TclWinSetSockOpt(SOCKET s, int level, int optname, const char *optval, int optlen) } declare 8 win { - unsigned long TclpGetPid(Tcl_Pid pid) + int TclpGetPid(Tcl_Pid pid) } declare 9 win { int TclWinGetPlatformId(void) } +# new for 8.4.20+/8.5.12+ Cygwin only +declare 10 win { + Tcl_DirEntry *TclpReaddir(DIR *dir) +} # Removed in 8.3.1 (for Win32s only) #declare 10 win { # int TclWinSynchSpawn(void *args, int type, void **trans, Tcl_Pid *pidPtr) @@ -1001,9 +1019,9 @@ declare 14 win { int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe) } declare 15 win { - int TclpCreateProcess(Tcl_Interp *interp, int argc, const char **argv, - TclFile inputFile, TclFile outputFile, TclFile errorFile, - Tcl_Pid *pidPtr) + int TclpCreateProcess(Tcl_Interp *interp, int argc, + const char **argv, TclFile inputFile, TclFile outputFile, + TclFile errorFile, Tcl_Pid *pidPtr) } # Signature changed in 8.1: # declare 16 win { @@ -1021,7 +1039,10 @@ declare 19 win { declare 20 win { void TclWinAddProcess(HANDLE hProcess, DWORD id) } - +# new for 8.4.20+/8.5.12+ +declare 21 win { + char *TclpInetNtoa(struct in_addr addr) +} # removed permanently for 8.4 #declare 21 win { # void TclpAsyncMark(Tcl_AsyncHandler async) @@ -1065,13 +1086,11 @@ declare 29 win { # Pipe channel functions -# On non-cygwin, this is actually a reference to TclGetAndDetachPids declare 0 unix { - void TclWinConvertError(unsigned int errCode) + void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan) } -# On non-cygwin, this is actually a reference to TclpCloseFile declare 1 unix { - void TclWinConvertWSAError(unsigned int errCode) + int TclpCloseFile(TclFile file) } declare 2 unix { Tcl_Channel TclpCreateCommandChannel(TclFile readFile, @@ -1080,23 +1099,20 @@ declare 2 unix { declare 3 unix { int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe) } -# On non-cygwin, this is actually a reference to TclpCreateProcess declare 4 unix { - void *TclWinGetTclInstance(void) + int TclpCreateProcess(Tcl_Interp *interp, int argc, + const char **argv, TclFile inputFile, TclFile outputFile, + TclFile errorFile, Tcl_Pid *pidPtr) } # Signature changed in 8.1: # declare 5 unix { # TclFile TclpCreateTempFile(char *contents, Tcl_DString *namePtr) # } - -# On non-cygwin, this is actually a reference to TclpMakeFile declare 6 unix { - unsigned short TclWinNToHS(unsigned short ns) + TclFile TclpMakeFile(Tcl_Channel channel, int direction) } -# On non-cygwin, this is actually a reference to TclpOpenFile declare 7 unix { - int TclWinSetSockOpt(void *s, int level, int optname, - const char *optval, int optlen) + TclFile TclpOpenFile(const char *fname, int mode) } declare 8 unix { int TclUnixWaitForFile(int fd, int mask, int timeout) @@ -1104,9 +1120,8 @@ declare 8 unix { # Added in 8.1: -# On non-cygwin, this is actually a reference to TclpCreateTempFile declare 9 unix { - int TclWinGetPlatformId(void) + TclFile TclpCreateTempFile(const char *contents) } # Added in 8.4: @@ -1116,11 +1131,9 @@ declare 10 unix { } # Slots 11 and 12 are forwarders for functions that were promoted to # generic Stubs -# On cygwin, this is actually a reference to TclGetAndDetachPids declare 11 unix { struct tm *TclpLocaltime_unix(const time_t *clock) } -# On cygwin, this is actually a reference to TclpCloseFile declare 12 unix { struct tm *TclpGmtime_unix(const time_t *clock) } @@ -1138,8 +1151,7 @@ declare 14 unix { ################################ # Mac OS X specific functions -#On cygwin, TclpCreateProcess is here -declare 15 {unix macosx} { +declare 15 macosx { int TclMacOSXGetFileAttribute(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr) } @@ -1151,44 +1163,17 @@ declare 17 macosx { int TclMacOSXCopyFileAttributes(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr) } -#On cygwin, TclpMakeFile is here -declare 18 {unix macosx} { +declare 18 macosx { int TclMacOSXMatchType(Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types) } -#On cygwin, TclpOpenFile is here -declare 19 {unix macosx} { +declare 19 macosx { void TclMacOSXNotifierAddRunLoopMode(const void *runLoopMode) } -declare 20 unix { - void TclWinAddProcess(void *hProcess, unsigned int id) -} -declare 22 unix { - TclFile TclpCreateTempFile(const char *contents) -} -declare 24 unix { - char *TclWinNoBackslash(char *path) -} -declare 26 unix { - void TclWinSetInterfaces(int wide) -} -declare 27 unix { - void TclWinFlushDirtyChannels(void) -} -declare 28 unix { - void TclWinResetInterfaces(void) -} declare 29 unix { int TclWinCPUID(unsigned int index, unsigned int *regs) } -declare 30 unix { - void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan) -} -declare 31 unix { - int TclpCloseFile(TclFile file) -} - # Local Variables: # mode: tcl diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 365f529..3ccc50a 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -456,27 +456,11 @@ EXTERN void TclTeardownNamespace(Namespace *nsPtr); /* 109 */ EXTERN int TclUpdateReturnInfo(Interp *iPtr); #endif -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ #ifndef TclSockMinimumBuffers_TCL_DECLARED #define TclSockMinimumBuffers_TCL_DECLARED /* 110 */ EXTERN int TclSockMinimumBuffers(VOID *sock, int size); #endif -#endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ -#ifndef TclSockMinimumBuffers_TCL_DECLARED -#define TclSockMinimumBuffers_TCL_DECLARED -/* 110 */ -EXTERN int TclSockMinimumBuffers(VOID *sock, int size); -#endif -#endif /* WIN */ -#ifdef MAC_OSX_TCL /* MACOSX */ -#ifndef TclSockMinimumBuffers_TCL_DECLARED -#define TclSockMinimumBuffers_TCL_DECLARED -/* 110 */ -EXTERN int TclSockMinimumBuffers(VOID *sock, int size); -#endif -#endif /* MACOSX */ #ifndef Tcl_AddInterpResolvers_TCL_DECLARED #define Tcl_AddInterpResolvers_TCL_DECLARED /* 111 */ @@ -1184,15 +1168,7 @@ typedef struct TclIntStubs { VOID *reserved107; void (*tclTeardownNamespace) (Namespace *nsPtr); /* 108 */ int (*tclUpdateReturnInfo) (Interp *iPtr); /* 109 */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ int (*tclSockMinimumBuffers) (VOID *sock, int size); /* 110 */ -#endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ - int (*tclSockMinimumBuffers) (VOID *sock, int size); /* 110 */ -#endif /* WIN */ -#ifdef MAC_OSX_TCL /* MACOSX */ - int (*tclSockMinimumBuffers) (VOID *sock, int size); /* 110 */ -#endif /* MACOSX */ void (*tcl_AddInterpResolvers) (Tcl_Interp *interp, CONST char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 111 */ int (*tcl_AppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 112 */ Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, CONST char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 113 */ @@ -1641,24 +1617,10 @@ extern TclIntStubs *tclIntStubsPtr; #define TclUpdateReturnInfo \ (tclIntStubsPtr->tclUpdateReturnInfo) /* 109 */ #endif -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ -#ifndef TclSockMinimumBuffers -#define TclSockMinimumBuffers \ - (tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */ -#endif -#endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ -#ifndef TclSockMinimumBuffers -#define TclSockMinimumBuffers \ - (tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */ -#endif -#endif /* WIN */ -#ifdef MAC_OSX_TCL /* MACOSX */ #ifndef TclSockMinimumBuffers #define TclSockMinimumBuffers \ (tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */ #endif -#endif /* MACOSX */ #ifndef Tcl_AddInterpResolvers #define Tcl_AddInterpResolvers \ (tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */ diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index b3976c8..b5783f8 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -13,6 +13,11 @@ #ifndef _TCLINTPLATDECLS #define _TCLINTPLATDECLS +#ifdef __WIN32__ +# define Tcl_DirEntry void +# define DIR void +#endif + #undef TCL_STORAGE_CLASS #ifdef BUILD_tcl # define TCL_STORAGE_CLASS DLLEXPORT @@ -24,16 +29,6 @@ # endif #endif -#if !defined(__WIN32__) /* UNIX */ -EXTERN int TclpCreateProcess(Tcl_Interp *interp, - int argc, CONST char **argv, TclFile inputFile, - TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); -EXTERN TclFile TclpMakeFile(Tcl_Channel channel, - int direction); -EXTERN TclFile TclpOpenFile(CONST char *fname, - int mode); -#endif - /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made @@ -46,16 +41,17 @@ EXTERN TclFile TclpOpenFile(CONST char *fname, * Exported function declarations: */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ -#ifndef TclWinConvertError_TCL_DECLARED -#define TclWinConvertError_TCL_DECLARED +#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ +#ifndef TclGetAndDetachPids_TCL_DECLARED +#define TclGetAndDetachPids_TCL_DECLARED /* 0 */ -EXTERN void TclWinConvertError(unsigned int errCode); +EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, + Tcl_Channel chan); #endif -#ifndef TclWinConvertWSAError_TCL_DECLARED -#define TclWinConvertWSAError_TCL_DECLARED +#ifndef TclpCloseFile_TCL_DECLARED +#define TclpCloseFile_TCL_DECLARED /* 1 */ -EXTERN void TclWinConvertWSAError(unsigned int errCode); +EXTERN int TclpCloseFile(TclFile file); #endif #ifndef TclpCreateCommandChannel_TCL_DECLARED #define TclpCreateCommandChannel_TCL_DECLARED @@ -69,32 +65,34 @@ EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile, /* 3 */ EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe); #endif -#ifndef TclWinGetTclInstance_TCL_DECLARED -#define TclWinGetTclInstance_TCL_DECLARED +#ifndef TclpCreateProcess_TCL_DECLARED +#define TclpCreateProcess_TCL_DECLARED /* 4 */ -EXTERN VOID * TclWinGetTclInstance(void); +EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc, + CONST char **argv, TclFile inputFile, + TclFile outputFile, TclFile errorFile, + Tcl_Pid *pidPtr); #endif /* Slot 5 is reserved */ -#ifndef TclWinNToHS_TCL_DECLARED -#define TclWinNToHS_TCL_DECLARED +#ifndef TclpMakeFile_TCL_DECLARED +#define TclpMakeFile_TCL_DECLARED /* 6 */ -EXTERN unsigned short TclWinNToHS(unsigned short ns); +EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); #endif -#ifndef TclWinSetSockOpt_TCL_DECLARED -#define TclWinSetSockOpt_TCL_DECLARED +#ifndef TclpOpenFile_TCL_DECLARED +#define TclpOpenFile_TCL_DECLARED /* 7 */ -EXTERN int TclWinSetSockOpt(VOID *s, int level, int optname, - CONST char *optval, int optlen); +EXTERN TclFile TclpOpenFile(CONST char *fname, int mode); #endif #ifndef TclUnixWaitForFile_TCL_DECLARED #define TclUnixWaitForFile_TCL_DECLARED /* 8 */ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); #endif -#ifndef TclWinGetPlatformId_TCL_DECLARED -#define TclWinGetPlatformId_TCL_DECLARED +#ifndef TclpCreateTempFile_TCL_DECLARED +#define TclpCreateTempFile_TCL_DECLARED /* 9 */ -EXTERN int TclWinGetPlatformId(void); +EXTERN TclFile TclpCreateTempFile(CONST char *contents); #endif #ifndef TclpReaddir_TCL_DECLARED #define TclpReaddir_TCL_DECLARED @@ -123,80 +121,27 @@ EXTERN int TclUnixCopyFile(CONST char *src, CONST char *dst, CONST Tcl_StatBuf *statBufPtr, int dontCopyAtts); #endif -#ifndef TclMacOSXGetFileAttribute_TCL_DECLARED -#define TclMacOSXGetFileAttribute_TCL_DECLARED -/* 15 */ -EXTERN int TclMacOSXGetFileAttribute(Tcl_Interp *interp, - int objIndex, Tcl_Obj *fileName, - Tcl_Obj **attributePtrPtr); -#endif +/* Slot 15 is reserved */ /* Slot 16 is reserved */ /* Slot 17 is reserved */ -#ifndef TclMacOSXMatchType_TCL_DECLARED -#define TclMacOSXMatchType_TCL_DECLARED -/* 18 */ -EXTERN int TclMacOSXMatchType(Tcl_Interp *interp, - CONST char *pathName, CONST char *fileName, - Tcl_StatBuf *statBufPtr, - Tcl_GlobTypeData *types); -#endif -#ifndef TclMacOSXNotifierAddRunLoopMode_TCL_DECLARED -#define TclMacOSXNotifierAddRunLoopMode_TCL_DECLARED -/* 19 */ -EXTERN void TclMacOSXNotifierAddRunLoopMode( - CONST VOID *runLoopMode); -#endif -#ifndef TclWinAddProcess_TCL_DECLARED -#define TclWinAddProcess_TCL_DECLARED -/* 20 */ -EXTERN void TclWinAddProcess(VOID *hProcess, unsigned int id); -#endif +/* Slot 18 is reserved */ +/* Slot 19 is reserved */ +/* Slot 20 is reserved */ /* Slot 21 is reserved */ -#ifndef TclpCreateTempFile_TCL_DECLARED -#define TclpCreateTempFile_TCL_DECLARED -/* 22 */ -EXTERN TclFile TclpCreateTempFile(CONST char *contents); -#endif +/* Slot 22 is reserved */ /* Slot 23 is reserved */ -#ifndef TclWinNoBackslash_TCL_DECLARED -#define TclWinNoBackslash_TCL_DECLARED -/* 24 */ -EXTERN char * TclWinNoBackslash(char *path); -#endif +/* Slot 24 is reserved */ /* Slot 25 is reserved */ -#ifndef TclWinSetInterfaces_TCL_DECLARED -#define TclWinSetInterfaces_TCL_DECLARED -/* 26 */ -EXTERN void TclWinSetInterfaces(int wide); -#endif -#ifndef TclWinFlushDirtyChannels_TCL_DECLARED -#define TclWinFlushDirtyChannels_TCL_DECLARED -/* 27 */ -EXTERN void TclWinFlushDirtyChannels(void); -#endif -#ifndef TclWinResetInterfaces_TCL_DECLARED -#define TclWinResetInterfaces_TCL_DECLARED -/* 28 */ -EXTERN void TclWinResetInterfaces(void); -#endif +/* Slot 26 is reserved */ +/* Slot 27 is reserved */ +/* Slot 28 is reserved */ #ifndef TclWinCPUID_TCL_DECLARED #define TclWinCPUID_TCL_DECLARED /* 29 */ EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs); #endif -#ifndef TclGetAndDetachPids_TCL_DECLARED -#define TclGetAndDetachPids_TCL_DECLARED -/* 30 */ -EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, - Tcl_Channel chan); -#endif -#ifndef TclpCloseFile_TCL_DECLARED -#define TclpCloseFile_TCL_DECLARED -/* 31 */ -EXTERN int TclpCloseFile(TclFile file); -#endif #endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ #ifndef TclWinConvertError_TCL_DECLARED #define TclWinConvertError_TCL_DECLARED /* 0 */ @@ -224,11 +169,15 @@ EXTERN int TclWinGetSockOpt(SOCKET s, int level, int optname, /* 4 */ EXTERN HINSTANCE TclWinGetTclInstance(void); #endif -/* Slot 5 is reserved */ +#ifndef TclUnixWaitForFile_TCL_DECLARED +#define TclUnixWaitForFile_TCL_DECLARED +/* 5 */ +EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); +#endif #ifndef TclWinNToHS_TCL_DECLARED #define TclWinNToHS_TCL_DECLARED /* 6 */ -EXTERN u_short TclWinNToHS(u_short ns); +EXTERN unsigned short TclWinNToHS(unsigned short ns); #endif #ifndef TclWinSetSockOpt_TCL_DECLARED #define TclWinSetSockOpt_TCL_DECLARED @@ -239,14 +188,18 @@ EXTERN int TclWinSetSockOpt(SOCKET s, int level, int optname, #ifndef TclpGetPid_TCL_DECLARED #define TclpGetPid_TCL_DECLARED /* 8 */ -EXTERN unsigned long TclpGetPid(Tcl_Pid pid); +EXTERN int TclpGetPid(Tcl_Pid pid); #endif #ifndef TclWinGetPlatformId_TCL_DECLARED #define TclWinGetPlatformId_TCL_DECLARED /* 9 */ EXTERN int TclWinGetPlatformId(void); #endif -/* Slot 10 is reserved */ +#ifndef TclpReaddir_TCL_DECLARED +#define TclpReaddir_TCL_DECLARED +/* 10 */ +EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir); +#endif #ifndef TclGetAndDetachPids_TCL_DECLARED #define TclGetAndDetachPids_TCL_DECLARED /* 11 */ @@ -295,7 +248,11 @@ EXTERN TclFile TclpOpenFile(CONST char *fname, int mode); /* 20 */ EXTERN void TclWinAddProcess(HANDLE hProcess, DWORD id); #endif -/* Slot 21 is reserved */ +#ifndef TclpInetNtoa_TCL_DECLARED +#define TclpInetNtoa_TCL_DECLARED +/* 21 */ +EXTERN char * TclpInetNtoa(struct in_addr addr); +#endif #ifndef TclpCreateTempFile_TCL_DECLARED #define TclpCreateTempFile_TCL_DECLARED /* 22 */ @@ -334,15 +291,16 @@ EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs); #endif #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ -#ifndef TclWinConvertError_TCL_DECLARED -#define TclWinConvertError_TCL_DECLARED +#ifndef TclGetAndDetachPids_TCL_DECLARED +#define TclGetAndDetachPids_TCL_DECLARED /* 0 */ -EXTERN void TclWinConvertError(unsigned int errCode); +EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, + Tcl_Channel chan); #endif -#ifndef TclWinConvertWSAError_TCL_DECLARED -#define TclWinConvertWSAError_TCL_DECLARED +#ifndef TclpCloseFile_TCL_DECLARED +#define TclpCloseFile_TCL_DECLARED /* 1 */ -EXTERN void TclWinConvertWSAError(unsigned int errCode); +EXTERN int TclpCloseFile(TclFile file); #endif #ifndef TclpCreateCommandChannel_TCL_DECLARED #define TclpCreateCommandChannel_TCL_DECLARED @@ -356,32 +314,34 @@ EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile, /* 3 */ EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe); #endif -#ifndef TclWinGetTclInstance_TCL_DECLARED -#define TclWinGetTclInstance_TCL_DECLARED +#ifndef TclpCreateProcess_TCL_DECLARED +#define TclpCreateProcess_TCL_DECLARED /* 4 */ -EXTERN VOID * TclWinGetTclInstance(void); +EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc, + CONST char **argv, TclFile inputFile, + TclFile outputFile, TclFile errorFile, + Tcl_Pid *pidPtr); #endif /* Slot 5 is reserved */ -#ifndef TclWinNToHS_TCL_DECLARED -#define TclWinNToHS_TCL_DECLARED +#ifndef TclpMakeFile_TCL_DECLARED +#define TclpMakeFile_TCL_DECLARED /* 6 */ -EXTERN unsigned short TclWinNToHS(unsigned short ns); +EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); #endif -#ifndef TclWinSetSockOpt_TCL_DECLARED -#define TclWinSetSockOpt_TCL_DECLARED +#ifndef TclpOpenFile_TCL_DECLARED +#define TclpOpenFile_TCL_DECLARED /* 7 */ -EXTERN int TclWinSetSockOpt(VOID *s, int level, int optname, - CONST char *optval, int optlen); +EXTERN TclFile TclpOpenFile(CONST char *fname, int mode); #endif #ifndef TclUnixWaitForFile_TCL_DECLARED #define TclUnixWaitForFile_TCL_DECLARED /* 8 */ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); #endif -#ifndef TclWinGetPlatformId_TCL_DECLARED -#define TclWinGetPlatformId_TCL_DECLARED +#ifndef TclpCreateTempFile_TCL_DECLARED +#define TclpCreateTempFile_TCL_DECLARED /* 9 */ -EXTERN int TclWinGetPlatformId(void); +EXTERN TclFile TclpCreateTempFile(CONST char *contents); #endif #ifndef TclpReaddir_TCL_DECLARED #define TclpReaddir_TCL_DECLARED @@ -445,107 +405,70 @@ EXTERN int TclMacOSXMatchType(Tcl_Interp *interp, EXTERN void TclMacOSXNotifierAddRunLoopMode( CONST VOID *runLoopMode); #endif -#ifndef TclWinAddProcess_TCL_DECLARED -#define TclWinAddProcess_TCL_DECLARED -/* 20 */ -EXTERN void TclWinAddProcess(VOID *hProcess, unsigned int id); -#endif +/* Slot 20 is reserved */ /* Slot 21 is reserved */ -#ifndef TclpCreateTempFile_TCL_DECLARED -#define TclpCreateTempFile_TCL_DECLARED -/* 22 */ -EXTERN TclFile TclpCreateTempFile(CONST char *contents); -#endif +/* Slot 22 is reserved */ /* Slot 23 is reserved */ -#ifndef TclWinNoBackslash_TCL_DECLARED -#define TclWinNoBackslash_TCL_DECLARED -/* 24 */ -EXTERN char * TclWinNoBackslash(char *path); -#endif +/* Slot 24 is reserved */ /* Slot 25 is reserved */ -#ifndef TclWinSetInterfaces_TCL_DECLARED -#define TclWinSetInterfaces_TCL_DECLARED -/* 26 */ -EXTERN void TclWinSetInterfaces(int wide); -#endif -#ifndef TclWinFlushDirtyChannels_TCL_DECLARED -#define TclWinFlushDirtyChannels_TCL_DECLARED -/* 27 */ -EXTERN void TclWinFlushDirtyChannels(void); -#endif -#ifndef TclWinResetInterfaces_TCL_DECLARED -#define TclWinResetInterfaces_TCL_DECLARED -/* 28 */ -EXTERN void TclWinResetInterfaces(void); -#endif +/* Slot 26 is reserved */ +/* Slot 27 is reserved */ +/* Slot 28 is reserved */ #ifndef TclWinCPUID_TCL_DECLARED #define TclWinCPUID_TCL_DECLARED /* 29 */ EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs); #endif -#ifndef TclGetAndDetachPids_TCL_DECLARED -#define TclGetAndDetachPids_TCL_DECLARED -/* 30 */ -EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, - Tcl_Channel chan); -#endif -#ifndef TclpCloseFile_TCL_DECLARED -#define TclpCloseFile_TCL_DECLARED -/* 31 */ -EXTERN int TclpCloseFile(TclFile file); -#endif #endif /* MACOSX */ typedef struct TclIntPlatStubs { int magic; struct TclIntPlatStubHooks *hooks; -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ - void (*tclWinConvertError) (unsigned int errCode); /* 0 */ - void (*tclWinConvertWSAError) (unsigned int errCode); /* 1 */ +#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ + void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */ + int (*tclpCloseFile) (TclFile file); /* 1 */ Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */ int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */ - VOID * (*tclWinGetTclInstance) (void); /* 4 */ + int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, CONST char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */ VOID *reserved5; - unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */ - int (*tclWinSetSockOpt) (VOID *s, int level, int optname, CONST char *optval, int optlen); /* 7 */ + TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */ + TclFile (*tclpOpenFile) (CONST char *fname, int mode); /* 7 */ int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */ - int (*tclWinGetPlatformId) (void); /* 9 */ + TclFile (*tclpCreateTempFile) (CONST char *contents); /* 9 */ Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */ struct tm * (*tclpLocaltime_unix) (CONST time_t *clock); /* 11 */ struct tm * (*tclpGmtime_unix) (CONST time_t *clock); /* 12 */ char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */ int (*tclUnixCopyFile) (CONST char *src, CONST char *dst, CONST Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */ - int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */ + VOID *reserved15; VOID *reserved16; VOID *reserved17; - int (*tclMacOSXMatchType) (Tcl_Interp *interp, CONST char *pathName, CONST char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */ - void (*tclMacOSXNotifierAddRunLoopMode) (CONST VOID *runLoopMode); /* 19 */ - void (*tclWinAddProcess) (VOID *hProcess, unsigned int id); /* 20 */ + VOID *reserved18; + VOID *reserved19; + VOID *reserved20; VOID *reserved21; - TclFile (*tclpCreateTempFile) (CONST char *contents); /* 22 */ + VOID *reserved22; VOID *reserved23; - char * (*tclWinNoBackslash) (char *path); /* 24 */ + VOID *reserved24; VOID *reserved25; - void (*tclWinSetInterfaces) (int wide); /* 26 */ - void (*tclWinFlushDirtyChannels) (void); /* 27 */ - void (*tclWinResetInterfaces) (void); /* 28 */ + VOID *reserved26; + VOID *reserved27; + VOID *reserved28; int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */ - void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 30 */ - int (*tclpCloseFile) (TclFile file); /* 31 */ #endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ void (*tclWinConvertError) (DWORD errCode); /* 0 */ void (*tclWinConvertWSAError) (DWORD errCode); /* 1 */ struct servent * (*tclWinGetServByName) (CONST char *nm, CONST char *proto); /* 2 */ int (*tclWinGetSockOpt) (SOCKET s, int level, int optname, char *optval, int *optlen); /* 3 */ HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */ - VOID *reserved5; - u_short (*tclWinNToHS) (u_short ns); /* 6 */ + int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */ + unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */ int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, CONST char *optval, int optlen); /* 7 */ - unsigned long (*tclpGetPid) (Tcl_Pid pid); /* 8 */ + int (*tclpGetPid) (Tcl_Pid pid); /* 8 */ int (*tclWinGetPlatformId) (void); /* 9 */ - VOID *reserved10; + Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */ void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */ int (*tclpCloseFile) (TclFile file); /* 12 */ Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */ @@ -556,7 +479,7 @@ typedef struct TclIntPlatStubs { TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */ TclFile (*tclpOpenFile) (CONST char *fname, int mode); /* 19 */ void (*tclWinAddProcess) (HANDLE hProcess, DWORD id); /* 20 */ - VOID *reserved21; + char * (*tclpInetNtoa) (struct in_addr addr); /* 21 */ TclFile (*tclpCreateTempFile) (CONST char *contents); /* 22 */ char * (*tclpGetTZName) (int isdst); /* 23 */ char * (*tclWinNoBackslash) (char *path); /* 24 */ @@ -567,16 +490,16 @@ typedef struct TclIntPlatStubs { int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ - void (*tclWinConvertError) (unsigned int errCode); /* 0 */ - void (*tclWinConvertWSAError) (unsigned int errCode); /* 1 */ + void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */ + int (*tclpCloseFile) (TclFile file); /* 1 */ Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */ int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */ - VOID * (*tclWinGetTclInstance) (void); /* 4 */ + int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, CONST char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */ VOID *reserved5; - unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */ - int (*tclWinSetSockOpt) (VOID *s, int level, int optname, CONST char *optval, int optlen); /* 7 */ + TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */ + TclFile (*tclpOpenFile) (CONST char *fname, int mode); /* 7 */ int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */ - int (*tclWinGetPlatformId) (void); /* 9 */ + TclFile (*tclpCreateTempFile) (CONST char *contents); /* 9 */ Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */ struct tm * (*tclpLocaltime_unix) (CONST time_t *clock); /* 11 */ struct tm * (*tclpGmtime_unix) (CONST time_t *clock); /* 12 */ @@ -587,18 +510,16 @@ typedef struct TclIntPlatStubs { int (*tclMacOSXCopyFileAttributes) (CONST char *src, CONST char *dst, CONST Tcl_StatBuf *statBufPtr); /* 17 */ int (*tclMacOSXMatchType) (Tcl_Interp *interp, CONST char *pathName, CONST char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */ void (*tclMacOSXNotifierAddRunLoopMode) (CONST VOID *runLoopMode); /* 19 */ - void (*tclWinAddProcess) (VOID *hProcess, unsigned int id); /* 20 */ + VOID *reserved20; VOID *reserved21; - TclFile (*tclpCreateTempFile) (CONST char *contents); /* 22 */ + VOID *reserved22; VOID *reserved23; - char * (*tclWinNoBackslash) (char *path); /* 24 */ + VOID *reserved24; VOID *reserved25; - void (*tclWinSetInterfaces) (int wide); /* 26 */ - void (*tclWinFlushDirtyChannels) (void); /* 27 */ - void (*tclWinResetInterfaces) (void); /* 28 */ + VOID *reserved26; + VOID *reserved27; + VOID *reserved28; int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */ - void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 30 */ - int (*tclpCloseFile) (TclFile file); /* 31 */ #endif /* MACOSX */ } TclIntPlatStubs; @@ -616,14 +537,14 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr; * Inline function declarations: */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ -#ifndef TclWinConvertError -#define TclWinConvertError \ - (tclIntPlatStubsPtr->tclWinConvertError) /* 0 */ +#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ +#ifndef TclGetAndDetachPids +#define TclGetAndDetachPids \ + (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */ #endif -#ifndef TclWinConvertWSAError -#define TclWinConvertWSAError \ - (tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */ +#ifndef TclpCloseFile +#define TclpCloseFile \ + (tclIntPlatStubsPtr->tclpCloseFile) /* 1 */ #endif #ifndef TclpCreateCommandChannel #define TclpCreateCommandChannel \ @@ -633,26 +554,26 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr; #define TclpCreatePipe \ (tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */ #endif -#ifndef TclWinGetTclInstance -#define TclWinGetTclInstance \ - (tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */ +#ifndef TclpCreateProcess +#define TclpCreateProcess \ + (tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */ #endif /* Slot 5 is reserved */ -#ifndef TclWinNToHS -#define TclWinNToHS \ - (tclIntPlatStubsPtr->tclWinNToHS) /* 6 */ +#ifndef TclpMakeFile +#define TclpMakeFile \ + (tclIntPlatStubsPtr->tclpMakeFile) /* 6 */ #endif -#ifndef TclWinSetSockOpt -#define TclWinSetSockOpt \ - (tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */ +#ifndef TclpOpenFile +#define TclpOpenFile \ + (tclIntPlatStubsPtr->tclpOpenFile) /* 7 */ #endif #ifndef TclUnixWaitForFile #define TclUnixWaitForFile \ (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */ #endif -#ifndef TclWinGetPlatformId -#define TclWinGetPlatformId \ - (tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */ +#ifndef TclpCreateTempFile +#define TclpCreateTempFile \ + (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ #endif #ifndef TclpReaddir #define TclpReaddir \ @@ -674,61 +595,26 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr; #define TclUnixCopyFile \ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */ #endif -#ifndef TclMacOSXGetFileAttribute -#define TclMacOSXGetFileAttribute \ - (tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */ -#endif +/* Slot 15 is reserved */ /* Slot 16 is reserved */ /* Slot 17 is reserved */ -#ifndef TclMacOSXMatchType -#define TclMacOSXMatchType \ - (tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */ -#endif -#ifndef TclMacOSXNotifierAddRunLoopMode -#define TclMacOSXNotifierAddRunLoopMode \ - (tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */ -#endif -#ifndef TclWinAddProcess -#define TclWinAddProcess \ - (tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */ -#endif +/* Slot 18 is reserved */ +/* Slot 19 is reserved */ +/* Slot 20 is reserved */ /* Slot 21 is reserved */ -#ifndef TclpCreateTempFile -#define TclpCreateTempFile \ - (tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */ -#endif +/* Slot 22 is reserved */ /* Slot 23 is reserved */ -#ifndef TclWinNoBackslash -#define TclWinNoBackslash \ - (tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */ -#endif +/* Slot 24 is reserved */ /* Slot 25 is reserved */ -#ifndef TclWinSetInterfaces -#define TclWinSetInterfaces \ - (tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */ -#endif -#ifndef TclWinFlushDirtyChannels -#define TclWinFlushDirtyChannels \ - (tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */ -#endif -#ifndef TclWinResetInterfaces -#define TclWinResetInterfaces \ - (tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */ -#endif +/* Slot 26 is reserved */ +/* Slot 27 is reserved */ +/* Slot 28 is reserved */ #ifndef TclWinCPUID #define TclWinCPUID \ (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */ #endif -#ifndef TclGetAndDetachPids -#define TclGetAndDetachPids \ - (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 30 */ -#endif -#ifndef TclpCloseFile -#define TclpCloseFile \ - (tclIntPlatStubsPtr->tclpCloseFile) /* 31 */ -#endif #endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ #ifndef TclWinConvertError #define TclWinConvertError \ (tclIntPlatStubsPtr->tclWinConvertError) /* 0 */ @@ -749,7 +635,10 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr; #define TclWinGetTclInstance \ (tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */ #endif -/* Slot 5 is reserved */ +#ifndef TclUnixWaitForFile +#define TclUnixWaitForFile \ + (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */ +#endif #ifndef TclWinNToHS #define TclWinNToHS \ (tclIntPlatStubsPtr->tclWinNToHS) /* 6 */ @@ -766,7 +655,10 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr; #define TclWinGetPlatformId \ (tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */ #endif -/* Slot 10 is reserved */ +#ifndef TclpReaddir +#define TclpReaddir \ + (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ +#endif #ifndef TclGetAndDetachPids #define TclGetAndDetachPids \ (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */ @@ -801,7 +693,10 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr; #define TclWinAddProcess \ (tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */ #endif -/* Slot 21 is reserved */ +#ifndef TclpInetNtoa +#define TclpInetNtoa \ + (tclIntPlatStubsPtr->tclpInetNtoa) /* 21 */ +#endif #ifndef TclpCreateTempFile #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */ @@ -833,13 +728,13 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr; #endif #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ -#ifndef TclWinConvertError -#define TclWinConvertError \ - (tclIntPlatStubsPtr->tclWinConvertError) /* 0 */ +#ifndef TclGetAndDetachPids +#define TclGetAndDetachPids \ + (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */ #endif -#ifndef TclWinConvertWSAError -#define TclWinConvertWSAError \ - (tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */ +#ifndef TclpCloseFile +#define TclpCloseFile \ + (tclIntPlatStubsPtr->tclpCloseFile) /* 1 */ #endif #ifndef TclpCreateCommandChannel #define TclpCreateCommandChannel \ @@ -849,26 +744,26 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr; #define TclpCreatePipe \ (tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */ #endif -#ifndef TclWinGetTclInstance -#define TclWinGetTclInstance \ - (tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */ +#ifndef TclpCreateProcess +#define TclpCreateProcess \ + (tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */ #endif /* Slot 5 is reserved */ -#ifndef TclWinNToHS -#define TclWinNToHS \ - (tclIntPlatStubsPtr->tclWinNToHS) /* 6 */ +#ifndef TclpMakeFile +#define TclpMakeFile \ + (tclIntPlatStubsPtr->tclpMakeFile) /* 6 */ #endif -#ifndef TclWinSetSockOpt -#define TclWinSetSockOpt \ - (tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */ +#ifndef TclpOpenFile +#define TclpOpenFile \ + (tclIntPlatStubsPtr->tclpOpenFile) /* 7 */ #endif #ifndef TclUnixWaitForFile #define TclUnixWaitForFile \ (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */ #endif -#ifndef TclWinGetPlatformId -#define TclWinGetPlatformId \ - (tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */ +#ifndef TclpCreateTempFile +#define TclpCreateTempFile \ + (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ #endif #ifndef TclpReaddir #define TclpReaddir \ @@ -910,45 +805,19 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr; #define TclMacOSXNotifierAddRunLoopMode \ (tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */ #endif -#ifndef TclWinAddProcess -#define TclWinAddProcess \ - (tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */ -#endif +/* Slot 20 is reserved */ /* Slot 21 is reserved */ -#ifndef TclpCreateTempFile -#define TclpCreateTempFile \ - (tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */ -#endif +/* Slot 22 is reserved */ /* Slot 23 is reserved */ -#ifndef TclWinNoBackslash -#define TclWinNoBackslash \ - (tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */ -#endif +/* Slot 24 is reserved */ /* Slot 25 is reserved */ -#ifndef TclWinSetInterfaces -#define TclWinSetInterfaces \ - (tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */ -#endif -#ifndef TclWinFlushDirtyChannels -#define TclWinFlushDirtyChannels \ - (tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */ -#endif -#ifndef TclWinResetInterfaces -#define TclWinResetInterfaces \ - (tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */ -#endif +/* Slot 26 is reserved */ +/* Slot 27 is reserved */ +/* Slot 28 is reserved */ #ifndef TclWinCPUID #define TclWinCPUID \ (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */ #endif -#ifndef TclGetAndDetachPids -#define TclGetAndDetachPids \ - (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 30 */ -#endif -#ifndef TclpCloseFile -#define TclpCloseFile \ - (tclIntPlatStubsPtr->tclpCloseFile) /* 31 */ -#endif #endif /* MACOSX */ #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ @@ -960,35 +829,9 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr; #undef TclpLocaltime_unix #undef TclpGmtime_unix -#if !defined(__WIN32__) && defined(USE_TCL_STUBS) -# ifdef __CYGWIN__ -# define TclpCreateProcess ((int (*) _ANSI_ARGS_((Tcl_Interp *, int, \ - CONST char **, TclFile, TclFile, TclFile, Tcl_Pid *))) \ - tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) -# define TclpMakeFile ((TclFile (*) _ANSI_ARGS_((Tcl_Channel channel, \ - int direction))) tclIntPlatStubsPtr->tclMacOSXMatchType) -# define TclpOpenFile ((TclFile (*) _ANSI_ARGS_((CONST char *, int))) \ - tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) -# else -# define TclpCreateProcess ((int (*) _ANSI_ARGS_((Tcl_Interp *, int, \ - CONST char **, TclFile, TclFile, TclFile, Tcl_Pid *))) \ - tclIntPlatStubsPtr->tclWinGetTclInstance) -# define TclpMakeFile ((TclFile (*) _ANSI_ARGS_((Tcl_Channel channel, \ - int direction))) tclIntPlatStubsPtr->tclWinNToHS) -# define TclpOpenFile ((TclFile (*) _ANSI_ARGS_((CONST char *, int))) \ - tclIntPlatStubsPtr->tclWinNToHS) - -# undef TclpCreateTempFile -# undef TclGetAndDetachPids -# undef TclpCloseFile - -# define TclpCreateTempFile ((TclFile (*) _ANSI_ARGS_((CONST char *))) \ - tclIntPlatStubsPtr->tclWinGetPlatformId) -# define TclGetAndDetachPids ((void (*) _ANSI_ARGS_((Tcl_Interp *, Tcl_Channel))) \ - tclIntPlatStubsPtr->tclWinConvertError) -# define TclpCloseFile ((int (*) _ANSI_ARGS_((TclFile))) \ - tclIntPlatStubsPtr->tclWinConvertWSAError) -# endif +#if !defined(__WIN32__) && !defined(__CYGWIN__) +# undef TclpGetPid +# define TclpGetPid(pid) ((unsigned long) (pid)) #endif #endif /* _TCLINTPLATDECLS */ diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index b6f3205..cde554c 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -1091,7 +1091,7 @@ Tcl_FSJoinPath( if (length > 0 && ptr[length -1] != '/') { Tcl_AppendToObj(res, &separator, 1); - length++; + Tcl_GetStringFromObj(res, &length); } Tcl_SetObjLength(res, length + (int) strlen(strElt)); diff --git a/generic/tclPipe.c b/generic/tclPipe.c index dd70e5e..698f85d 100644 --- a/generic/tclPipe.c +++ b/generic/tclPipe.c @@ -280,7 +280,7 @@ TclCleanupChildren( for (i = 0; i < numPids; i++) { /* * We need to get the resolved pid before we wait on it as the windows - * implimentation of Tcl_WaitPid deletes the information such that any + * implementation of Tcl_WaitPid deletes the information such that any * following calls to TclpGetPid fail. */ diff --git a/generic/tclPlatDecls.h b/generic/tclPlatDecls.h index d52a736..8652e8d 100644 --- a/generic/tclPlatDecls.h +++ b/generic/tclPlatDecls.h @@ -22,19 +22,16 @@ #endif /* - * Pull in the typedef of TCHAR for windows. + * TCHAR is needed here for win32, so if it is not defined yet do it here. + * This way, we don't need to include <tchar.h> just for one define. */ -#if defined(__WIN32__) && !defined(_TCHAR_DEFINED) -# include <tchar.h> -# ifndef _TCHAR_DEFINED - /* Borland seems to forget to set this. */ - typedef _TCHAR TCHAR; -# define _TCHAR_DEFINED -# endif -# if defined(_MSC_VER) && defined(__STDC__) - /* VS2005 SP1 misses this. See [Bug #3110161] */ - typedef _TCHAR TCHAR; +#if (defined(_WIN32) || defined(__CYGWIN__)) && !defined(_TCHAR_DEFINED) +# if defined(_UNICODE) + typedef wchar_t TCHAR; +# else + typedef char TCHAR; # endif +# define _TCHAR_DEFINED #endif /* !BEGIN!: Do not edit below this line. */ @@ -43,25 +40,7 @@ * Exported function declarations: */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ -#ifndef Tcl_MacOSXOpenBundleResources_TCL_DECLARED -#define Tcl_MacOSXOpenBundleResources_TCL_DECLARED -/* 0 */ -EXTERN int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp, - CONST char *bundleName, int hasResourceFile, - int maxPathLen, char *libraryPath); -#endif -#ifndef Tcl_MacOSXOpenVersionedBundleResources_TCL_DECLARED -#define Tcl_MacOSXOpenVersionedBundleResources_TCL_DECLARED -/* 1 */ -EXTERN int Tcl_MacOSXOpenVersionedBundleResources( - Tcl_Interp *interp, CONST char *bundleName, - CONST char *bundleVersion, - int hasResourceFile, int maxPathLen, - char *libraryPath); -#endif -#endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ #ifndef Tcl_WinUtfToTChar_TCL_DECLARED #define Tcl_WinUtfToTChar_TCL_DECLARED /* 0 */ @@ -98,11 +77,7 @@ typedef struct TclPlatStubs { int magic; struct TclPlatStubHooks *hooks; -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ - int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, CONST char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 0 */ - int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, CONST char *bundleName, CONST char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */ -#endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ TCHAR * (*tcl_WinUtfToTChar) (CONST char *str, int len, Tcl_DString *dsPtr); /* 0 */ char * (*tcl_WinTCharToUtf) (CONST TCHAR *str, int len, Tcl_DString *dsPtr); /* 1 */ #endif /* WIN */ @@ -126,17 +101,7 @@ extern TclPlatStubs *tclPlatStubsPtr; * Inline function declarations: */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ -#ifndef Tcl_MacOSXOpenBundleResources -#define Tcl_MacOSXOpenBundleResources \ - (tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */ -#endif -#ifndef Tcl_MacOSXOpenVersionedBundleResources -#define Tcl_MacOSXOpenVersionedBundleResources \ - (tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */ -#endif -#endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ #ifndef Tcl_WinUtfToTChar #define Tcl_WinUtfToTChar \ (tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */ diff --git a/generic/tclPort.h b/generic/tclPort.h index 79bea88..7021b8d 100644 --- a/generic/tclPort.h +++ b/generic/tclPort.h @@ -25,19 +25,6 @@ # include "tclUnixPort.h" #endif -#if defined(__CYGWIN__) -# 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); - DLLIMPORT extern void __stdcall SetEnvironmentVariableA(const char*, const char *); -#endif - #if !defined(LLONG_MIN) # ifdef TCL_WIDE_INT_IS_LONG # define LLONG_MIN LONG_MIN diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index e28a5c7..418e42f 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -31,6 +31,7 @@ #undef Tcl_ValidateAllMemory #undef Tcl_FindHashEntry #undef Tcl_CreateHashEntry +#undef TclpGetPid #undef TclSockMinimumBuffers /* @@ -74,28 +75,19 @@ MODULE_SCOPE TclPlatStubs tclPlatStubs; MODULE_SCOPE TclStubs tclStubs; MODULE_SCOPE TclTomMathStubs tclTomMathStubs; -#ifdef __CYGWIN__ - -/* Trick, so we don't have to include <windows.h> here, which - * - b.t.w. - lacks this function anyway */ -#define GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS 0x00000004 -int __stdcall GetModuleHandleExW(unsigned int, const char *, void *); - -#define TclWinGetPlatformId winGetPlatformId -#define Tcl_WinUtfToTChar winUtfToTChar -#define Tcl_WinTCharToUtf winTCharToUtf -#define TclWinGetTclInstance winGetTclInstance -#define TclWinNToHS winNToHS -#define TclWinSetSockOpt winSetSockOpt -#define TclWinNoBackslash winNoBackslash -#define TclWinSetInterfaces (void (*) (int)) doNothing -#define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing -#define TclWinFlushDirtyChannels doNothing -#define TclWinResetInterfaces doNothing +#ifdef __WIN32__ +# define TclUnixWaitForFile 0 +# define TclpReaddir 0 +#elif defined(__CYGWIN__) +# define TclWinSetInterfaces (void (*) (int)) doNothing +# define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing +# define TclWinFlushDirtyChannels doNothing +# define TclWinResetInterfaces doNothing +# define TclpGetTZName 0 static Tcl_Encoding winTCharEncoding; -static int +int TclWinGetPlatformId() { /* Don't bother to determine the real platform on cygwin, @@ -103,7 +95,7 @@ TclWinGetPlatformId() return 2; /* VER_PLATFORM_WIN32_NT */; } -static void *TclWinGetTclInstance() +void *TclWinGetTclInstance() { void *hInstance = NULL; GetModuleHandleExW(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS, @@ -111,20 +103,33 @@ static void *TclWinGetTclInstance() return hInstance; } -static unsigned short +unsigned short TclWinNToHS(unsigned short ns) { return ntohs(ns); } -static int -TclWinSetSockOpt(void *s, int level, int optname, +int +TclWinSetSockOpt(SOCKET s, int level, int optname, const char *optval, int optlen) { return setsockopt((int) s, level, optname, optval, optlen); } -static char * +int +TclWinGetSockOpt(SOCKET s, int level, int optname, + char *optval, int *optlen) +{ + return getsockopt((int) s, level, optname, optval, optlen); +} + +struct servent * +TclWinGetServByName(const char *name, const char *proto) +{ + return getservbyname(name, proto); +} + +char * TclWinNoBackslash(char *path) { char *p; @@ -137,17 +142,23 @@ TclWinNoBackslash(char *path) return path; } +int +TclpGetPid(Tcl_Pid pid) +{ + return (int) (size_t) pid; +} + static void doNothing(void) { /* dummy implementation, no need to do anything */ } -static char * -Tcl_WinUtfToTChar(string, len, dsPtr) - const char *string; - int len; - Tcl_DString *dsPtr; +char * +Tcl_WinUtfToTChar( + const char *string, + int len, + Tcl_DString *dsPtr) { if (!winTCharEncoding) { winTCharEncoding = Tcl_GetEncoding(0, "unicode"); @@ -156,7 +167,7 @@ Tcl_WinUtfToTChar(string, len, dsPtr) string, len, dsPtr); } -static char * +char * Tcl_WinTCharToUtf( const char *string, int len, @@ -169,37 +180,7 @@ Tcl_WinTCharToUtf( string, len, dsPtr); } -#define Tcl_MacOSXOpenBundleResources (int (*) _ANSI_ARGS_(( \ - Tcl_Interp *, const char *, int, int, char *))) Tcl_WinUtfToTChar -#define Tcl_MacOSXOpenVersionedBundleResources (int (*) _ANSI_ARGS_(( \ - Tcl_Interp *, const char *, const char *, int, int, char *))) Tcl_WinTCharToUtf -#define TclMacOSXGetFileAttribute (int (*) _ANSI_ARGS_((Tcl_Interp *, \ - int, Tcl_Obj *, Tcl_Obj **))) TclpCreateProcess -#define TclMacOSXMatchType (int (*) _ANSI_ARGS_((Tcl_Interp *, const char *, \ - const char *, Tcl_StatBuf *, Tcl_GlobTypeData *))) TclpMakeFile -#define TclMacOSXNotifierAddRunLoopMode (void (*) _ANSI_ARGS_((const void *))) TclpOpenFile -#define TclpLocaltime_unix (struct tm *(*) _ANSI_ARGS_((const time_t *))) TclGetAndDetachPids -#define TclpGmtime_unix (struct tm *(*) _ANSI_ARGS_((const time_t *))) TclpCloseFile - -#elif !defined(__WIN32__) /* UNIX and MAC */ -# define TclWinConvertError (void (*) _ANSI_ARGS_((unsigned int))) TclGetAndDetachPids -# define TclWinConvertWSAError (void (*) _ANSI_ARGS_((unsigned int))) TclpCloseFile -# define TclWinGetPlatformId (int (*)()) TclpCreateTempFile -# define TclWinGetTclInstance (void *(*)()) TclpCreateProcess -# define TclWinNToHS (unsigned short (*) _ANSI_ARGS_((unsigned short ns))) TclpMakeFile -# define TclWinSetSockOpt (int (*) _ANSI_ARGS_((void *, int, int, const char *, int))) TclpOpenFile -# define TclWinAddProcess 0 -# define TclWinNoBackslash 0 -# define TclWinSetInterfaces 0 -# define TclWinFlushDirtyChannels 0 -# define TclWinResetInterfaces 0 -# define TclMacOSXGetFileAttribute 0 /* Only implemented in Tcl >= 8.5 */ -# define TclMacOSXMatchType 0 /* Only implemented in Tcl >= 8.5 */ -# define TclMacOSXNotifierAddRunLoopMode 0 /* Only implemented in Tcl >= 8.5 */ -# ifndef MAC_OSX_TCL -# define Tcl_MacOSXOpenBundleResources 0 -# define Tcl_MacOSXOpenVersionedBundleResources 0 -# endif +#else /* UNIX and MAC */ # define TclpLocaltime_unix TclpLocaltime # define TclpGmtime_unix TclpGmtime #endif @@ -325,15 +306,7 @@ TclIntStubs tclIntStubs = { NULL, /* 107 */ TclTeardownNamespace, /* 108 */ TclUpdateReturnInfo, /* 109 */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ - TclSockMinimumBuffers, /* 110 */ -#endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ - TclSockMinimumBuffers, /* 110 */ -#endif /* WIN */ -#ifdef MAC_OSX_TCL /* MACOSX */ TclSockMinimumBuffers, /* 110 */ -#endif /* MACOSX */ Tcl_AddInterpResolvers, /* 111 */ Tcl_AppendExportList, /* 112 */ Tcl_CreateNamespace, /* 113 */ @@ -478,52 +451,50 @@ TclIntStubs tclIntStubs = { TclIntPlatStubs tclIntPlatStubs = { TCL_STUB_MAGIC, NULL, -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ - TclWinConvertError, /* 0 */ - TclWinConvertWSAError, /* 1 */ +#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ + TclGetAndDetachPids, /* 0 */ + TclpCloseFile, /* 1 */ TclpCreateCommandChannel, /* 2 */ TclpCreatePipe, /* 3 */ - TclWinGetTclInstance, /* 4 */ + TclpCreateProcess, /* 4 */ NULL, /* 5 */ - TclWinNToHS, /* 6 */ - TclWinSetSockOpt, /* 7 */ + TclpMakeFile, /* 6 */ + TclpOpenFile, /* 7 */ TclUnixWaitForFile, /* 8 */ - TclWinGetPlatformId, /* 9 */ + TclpCreateTempFile, /* 9 */ TclpReaddir, /* 10 */ TclpLocaltime_unix, /* 11 */ TclpGmtime_unix, /* 12 */ TclpInetNtoa, /* 13 */ TclUnixCopyFile, /* 14 */ - TclMacOSXGetFileAttribute, /* 15 */ + NULL, /* 15 */ NULL, /* 16 */ NULL, /* 17 */ - TclMacOSXMatchType, /* 18 */ - TclMacOSXNotifierAddRunLoopMode, /* 19 */ - TclWinAddProcess, /* 20 */ + NULL, /* 18 */ + NULL, /* 19 */ + NULL, /* 20 */ NULL, /* 21 */ - TclpCreateTempFile, /* 22 */ + NULL, /* 22 */ NULL, /* 23 */ - TclWinNoBackslash, /* 24 */ + NULL, /* 24 */ NULL, /* 25 */ - TclWinSetInterfaces, /* 26 */ - TclWinFlushDirtyChannels, /* 27 */ - TclWinResetInterfaces, /* 28 */ + NULL, /* 26 */ + NULL, /* 27 */ + NULL, /* 28 */ TclWinCPUID, /* 29 */ - TclGetAndDetachPids, /* 30 */ - TclpCloseFile, /* 31 */ #endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ TclWinConvertError, /* 0 */ TclWinConvertWSAError, /* 1 */ TclWinGetServByName, /* 2 */ TclWinGetSockOpt, /* 3 */ TclWinGetTclInstance, /* 4 */ - NULL, /* 5 */ + TclUnixWaitForFile, /* 5 */ TclWinNToHS, /* 6 */ TclWinSetSockOpt, /* 7 */ TclpGetPid, /* 8 */ TclWinGetPlatformId, /* 9 */ - NULL, /* 10 */ + TclpReaddir, /* 10 */ TclGetAndDetachPids, /* 11 */ TclpCloseFile, /* 12 */ TclpCreateCommandChannel, /* 13 */ @@ -534,7 +505,7 @@ TclIntPlatStubs tclIntPlatStubs = { TclpMakeFile, /* 18 */ TclpOpenFile, /* 19 */ TclWinAddProcess, /* 20 */ - NULL, /* 21 */ + TclpInetNtoa, /* 21 */ TclpCreateTempFile, /* 22 */ TclpGetTZName, /* 23 */ TclWinNoBackslash, /* 24 */ @@ -545,16 +516,16 @@ TclIntPlatStubs tclIntPlatStubs = { TclWinCPUID, /* 29 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ - TclWinConvertError, /* 0 */ - TclWinConvertWSAError, /* 1 */ + TclGetAndDetachPids, /* 0 */ + TclpCloseFile, /* 1 */ TclpCreateCommandChannel, /* 2 */ TclpCreatePipe, /* 3 */ - TclWinGetTclInstance, /* 4 */ + TclpCreateProcess, /* 4 */ NULL, /* 5 */ - TclWinNToHS, /* 6 */ - TclWinSetSockOpt, /* 7 */ + TclpMakeFile, /* 6 */ + TclpOpenFile, /* 7 */ TclUnixWaitForFile, /* 8 */ - TclWinGetPlatformId, /* 9 */ + TclpCreateTempFile, /* 9 */ TclpReaddir, /* 10 */ TclpLocaltime_unix, /* 11 */ TclpGmtime_unix, /* 12 */ @@ -565,29 +536,23 @@ TclIntPlatStubs tclIntPlatStubs = { TclMacOSXCopyFileAttributes, /* 17 */ TclMacOSXMatchType, /* 18 */ TclMacOSXNotifierAddRunLoopMode, /* 19 */ - TclWinAddProcess, /* 20 */ + NULL, /* 20 */ NULL, /* 21 */ - TclpCreateTempFile, /* 22 */ + NULL, /* 22 */ NULL, /* 23 */ - TclWinNoBackslash, /* 24 */ + NULL, /* 24 */ NULL, /* 25 */ - TclWinSetInterfaces, /* 26 */ - TclWinFlushDirtyChannels, /* 27 */ - TclWinResetInterfaces, /* 28 */ + NULL, /* 26 */ + NULL, /* 27 */ + NULL, /* 28 */ TclWinCPUID, /* 29 */ - TclGetAndDetachPids, /* 30 */ - TclpCloseFile, /* 31 */ #endif /* MACOSX */ }; TclPlatStubs tclPlatStubs = { TCL_STUB_MAGIC, NULL, -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ - Tcl_MacOSXOpenBundleResources, /* 0 */ - Tcl_MacOSXOpenVersionedBundleResources, /* 1 */ -#endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ Tcl_WinUtfToTChar, /* 0 */ Tcl_WinTCharToUtf, /* 1 */ #endif /* WIN */ @@ -684,19 +649,19 @@ TclStubs tclStubs = { Tcl_DbCkalloc, /* 6 */ Tcl_DbCkfree, /* 7 */ Tcl_DbCkrealloc, /* 8 */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ +#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ Tcl_CreateFileHandler, /* 9 */ #endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ NULL, /* 9 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ Tcl_CreateFileHandler, /* 9 */ #endif /* MACOSX */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ +#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ Tcl_DeleteFileHandler, /* 10 */ #endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ NULL, /* 10 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ @@ -858,10 +823,10 @@ TclStubs tclStubs = { Tcl_GetMaster, /* 164 */ Tcl_GetNameOfExecutable, /* 165 */ Tcl_GetObjResult, /* 166 */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ +#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ Tcl_GetOpenFile, /* 167 */ #endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ NULL, /* 167 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ diff --git a/generic/tclTest.c b/generic/tclTest.c index c08f281..ab0c6cb 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -444,6 +444,11 @@ static int TestNumUtfCharsCmd(ClientData clientData, static int TestHashSystemHashCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +#if defined(HAVE_CPUID) || defined(__WIN32__) +static int TestcpuidCmd (ClientData dummy, + Tcl_Interp* interp, int objc, + Tcl_Obj *CONST objv[]); +#endif static Tcl_Filesystem testReportingFilesystem = { "reporting", @@ -707,6 +712,10 @@ Tcltest_Init( (ClientData) NULL, NULL); Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd, (ClientData) NULL, NULL); +#if defined(HAVE_CPUID) || defined(__WIN32__) + Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd, + (ClientData) 0, NULL); +#endif t3ArgTypes[0] = TCL_EITHER; t3ArgTypes[1] = TCL_EITHER; Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2, @@ -3259,7 +3268,7 @@ TestlocaleCmd( "ctype", "numeric", "time", "collate", "monetary", "all", NULL }; - static int lcTypes[] = { + static CONST int lcTypes[] = { LC_CTYPE, LC_NUMERIC, LC_TIME, LC_COLLATE, LC_MONETARY, LC_ALL }; @@ -7103,6 +7112,62 @@ TestNumUtfCharsCmd( } return TCL_OK; } + +#if defined(HAVE_CPUID) || defined(__WIN32__) +/* + *---------------------------------------------------------------------- + * + * TestcpuidCmd -- + * + * Retrieves CPU ID information. + * + * Usage: + * testwincpuid <eax> + * + * Parameters: + * eax - The value to pass in the EAX register to a CPUID instruction. + * + * Results: + * Returns a four-element list containing the values from the EAX, EBX, + * ECX and EDX registers returned from the CPUID instruction. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestcpuidCmd( + ClientData dummy, + Tcl_Interp* interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj *const * objv) /* Parameter vector */ +{ + int status, index, i; + unsigned int regs[4]; + Tcl_Obj *regsObjs[4]; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "eax"); + return TCL_ERROR; + } + if (Tcl_GetIntFromObj(interp, objv[1], &index) != TCL_OK) { + return TCL_ERROR; + } + status = TclWinCPUID((unsigned) index, regs); + if (status != TCL_OK) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("operation not available", -1)); + return status; + } + for (i=0 ; i<4 ; ++i) { + regsObjs[i] = Tcl_NewIntObj((int) regs[i]); + } + Tcl_SetObjResult(interp, Tcl_NewListObj(4, regsObjs)); + return TCL_OK; +} +#endif /* * Used to do basic checks of the TCL_HASH_KEY_SYSTEM_HASH flag diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c index 88bd1c3..644179b 100644 --- a/generic/tclTestProcBodyObj.c +++ b/generic/tclTestProcBodyObj.c @@ -17,14 +17,14 @@ * name and version of this package */ -static char packageName[] = "procbodytest"; -static char packageVersion[] = "1.0"; +static const char packageName[] = "procbodytest"; +static const char packageVersion[] = "1.0"; /* * Name of the commands exported by this package */ -static char procCommand[] = "proc"; +static const char procCommand[] = "proc"; /* * this struct describes an entry in the table of command names and command @@ -33,7 +33,7 @@ static char procCommand[] = "proc"; typedef struct CmdTable { - char *cmdName; /* command name */ + const char *cmdName; /* command name */ Tcl_ObjCmdProc *proc; /* command proc */ int exportIt; /* if 1, export the command */ } CmdTable; @@ -46,7 +46,7 @@ static int ProcBodyTestProcObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int ProcBodyTestInitInternal(Tcl_Interp *interp, int isSafe); static int RegisterCommand(Tcl_Interp* interp, - char *namespace, CONST CmdTable *cmdTablePtr); + const char *namespace, const CmdTable *cmdTablePtr); int Procbodytest_Init(Tcl_Interp * interp); int Procbodytest_SafeInit(Tcl_Interp * interp); @@ -132,9 +132,9 @@ Procbodytest_SafeInit( static int RegisterCommand(interp, namespace, cmdTablePtr) Tcl_Interp* interp; /* the Tcl interpreter for which the operation * is performed */ - char *namespace; /* the namespace in which the command is + const char *namespace; /* the namespace in which the command is * registered */ - CONST CmdTable *cmdTablePtr;/* the command to register */ + const CmdTable *cmdTablePtr;/* the command to register */ { char buf[128]; diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 3ea182f..fa29160 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -110,10 +110,10 @@ static Tcl_TraceTypeObjCmd TraceExecutionObjCmd; static const char *traceTypeOptions[] = { "execution", "command", "variable", NULL }; -static Tcl_TraceTypeObjCmd *traceSubCmds[] = { +static Tcl_TraceTypeObjCmd *const traceSubCmds[] = { TraceExecutionObjCmd, TraceCommandObjCmd, - TraceVariableObjCmd, + TraceVariableObjCmd }; /* diff --git a/library/dde/pkgIndex.tcl b/library/dde/pkgIndex.tcl index 3125ada..96d5855 100644 --- a/library/dde/pkgIndex.tcl +++ b/library/dde/pkgIndex.tcl @@ -1,7 +1,7 @@ -if {![package vsatisfies [package provide Tcl] 8]} {return} -if {[string compare $::tcl_platform(platform) windows]} {return} +if {![package vsatisfies [package provide Tcl] 8]} return +if {[string compare [info sharedlibextension] .dll]} return if {[info exists ::tcl_platform(debug)]} { - package ifneeded dde 1.3.2 [list load [file join $dir tcldde13g.dll] dde] + package ifneeded dde 1.3.3 [list load [file join $dir tcldde13g.dll] dde] } else { - package ifneeded dde 1.3.2 [list load [file join $dir tcldde13.dll] dde] + package ifneeded dde 1.3.3 [list load [file join $dir tcldde13.dll] dde] } diff --git a/library/init.tcl b/library/init.tcl index 389f319..28689ab 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -660,7 +660,7 @@ proc auto_execok name { set execExtensions [list {} .com .exe .bat .cmd] } - if {$name in $shellBuiltins} { + if {[string tolower $name] in $shellBuiltins} { # When this is command.com for some reason on Win2K, Tcl won't # exec it unless the case is right, which this corrects. COMSPEC # may not point to a real file, so do the check. diff --git a/library/reg/pkgIndex.tcl b/library/reg/pkgIndex.tcl index d2ed72f..6fa8eda 100755 --- a/library/reg/pkgIndex.tcl +++ b/library/reg/pkgIndex.tcl @@ -1,5 +1,5 @@ -if {![package vsatisfies [package provide Tcl] 8]} {return} -if {[string compare $::tcl_platform(platform) windows]} {return} +if {![package vsatisfies [package provide Tcl] 8]} return +if {[string compare [info sharedlibextension] .dll]} return if {[info exists ::tcl_platform(debug)]} { package ifneeded registry 1.2.1 \ [list load [file join $dir tclreg12g.dll] registry] diff --git a/library/safe.tcl b/library/safe.tcl index 8a99032..1a340a1 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -491,7 +491,8 @@ proc ::safe::InterpInit { # now, after tm.tcl was loaded. namespace upvar ::safe S$slave state if {[llength $state(tm_path_slave)] > 0} { - ::interp eval $slave [list ::tcl::tm::add {*}$state(tm_path_slave)] + ::interp eval $slave [list \ + ::tcl::tm::add {*}[lreverse $state(tm_path_slave)]] } return $slave } @@ -670,9 +671,9 @@ proc ::safe::AliasGlob {slave args} { } if {$::tcl_platform(platform) eq "windows"} { - set dirPartRE {^(.*)[\\/]} + set dirPartRE {^(.*)[\\/]([^\\/]*)$} } else { - set dirPartRE {^(.*)/} + set dirPartRE {^(.*)/([^/]*)$} } set dir {} @@ -725,11 +726,10 @@ proc ::safe::AliasGlob {slave args} { DirInAccessPath $slave $dir } msg]} { Log $slave $msg - if {!$got(-nocomplain)} { - return -code error "permission denied" - } else { + if {$got(-nocomplain)} { return } + return -code error "permission denied" } lappend cmd -directory $dir } @@ -741,19 +741,32 @@ proc ::safe::AliasGlob {slave args} { # Process remaining pattern arguments set firstPattern [llength $cmd] - while {$at < [llength $args]} { - set opt [lindex $args $at] - incr at - if {[regexp $dirPartRE $opt -> thedir] && [catch { + foreach opt [lrange $args $at end] { + if {![regexp $dirPartRE $opt -> thedir thefile]} { + set thedir . + } + if {$thedir eq "*"} { + set mapped 0 + foreach d [glob -directory [TranslatePath $slave $virtualdir] \ + -types d -tails *] { + catch { + DirInAccessPath $slave \ + [TranslatePath $slave [file join $virtualdir $d]] + if {$thefile eq "pkgIndex.tcl" || $thefile eq "*.tm"} { + lappend cmd [file join $d $thefile] + set mapped 1 + } + } + } + if {$mapped} continue + } + if {[catch { set thedir [file join $virtualdir $thedir] DirInAccessPath $slave [TranslatePath $slave $thedir] } msg]} { Log $slave $msg - if {$got(-nocomplain)} { - continue - } else { - return -code error "permission denied" - } + if {$got(-nocomplain)} continue + return -code error "permission denied" } lappend cmd $opt } @@ -770,7 +783,7 @@ proc ::safe::AliasGlob {slave args} { return -code error "script error" } - Log $slave "GLOB @ $msg" NOTICE + Log $slave "GLOB < $msg" NOTICE # Translate path back to what the slave should see. set res {} @@ -782,7 +795,7 @@ proc ::safe::AliasGlob {slave args} { lappend res $p } - Log $slave "GLOB @ $res" NOTICE + Log $slave "GLOB > $res" NOTICE return $res } diff --git a/tests/platform.test b/tests/platform.test index 9d88f98..4f1eb82 100644 --- a/tests/platform.test +++ b/tests/platform.test @@ -14,7 +14,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } -testConstraint testWinCPUID [llength [info commands testwincpuid]] +testConstraint testCPUID [llength [info commands testcpuid]] test platform-1.1 {TclpSetVariables: tcl_platform} { interp create i @@ -36,12 +36,12 @@ test platform-2.1 {tcl_platform(wordSize) indicates size of native word} { list [expr {$result < 0}] [expr {$result ^ int($result - 1)}] } {1 -1} -# On Windows, test that the CPU ID works +# On Windows/UNIX, test that the CPU ID works -test platform-3.1 {CPU ID on Windows } \ - -constraints testWinCPUID \ +test platform-3.1 {CPU ID on Windows/UNIX} \ + -constraints testCPUID \ -body { - set cpudata [testwincpuid 0] + set cpudata [testcpuid 0] binary format iii \ [lindex $cpudata 1] \ [lindex $cpudata 3] \ diff --git a/tests/safe.test b/tests/safe.test index fbcb2a1..7b83cc6 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -30,7 +30,7 @@ set ::auto_path [info library] catch {safe::interpConfigure} proc equiv {x} {return $x} - + test safe-1.1 {safe::interpConfigure syntax} { list [catch {safe::interpConfigure} msg] $msg; } {1 {no value given for parameter "slave" (use -help for full usage) : @@ -515,6 +515,182 @@ test safe-12.6 {glob is restricted [Bug 2906841]} -setup { safe::interpDelete $i } -result {} +proc mkfile {filename} { + close [open $filename w] +} +#### New tests for Safe base glob, with patches @ Bug 2964715 +test safe-13.1 {glob is restricted [Bug 2964715]} -setup { + set i [safe::interpCreate] +} -body { + $i eval glob * +} -returnCodes error -cleanup { + safe::interpDelete $i +} -result {permission denied} +test safe-13.2 {mimic the valid glob call by ::tcl::tm::UnknownHandler [Bug 2964715]} -setup { + set i [safe::interpCreate] + set testdir [file join [temporaryDirectory] deletethisdir] + set testdir2 [file join $testdir deletemetoo] + set testfile [file join $testdir2 deleteme.tm] + file mkdir $testdir2 + mkfile $testfile +} -body { + ::safe::interpAddToAccessPath $i $testdir2 + set result [$i eval glob -nocomplain -directory $testdir2 *.tm] + if {$result eq [list $testfile]} { + return "glob match" + } else { + return "no match: $result" + } +} -cleanup { + safe::interpDelete $i + file delete -force $testdir +} -result {glob match} +test safe-13.3 {cf 13.2 but test glob failure when -directory is outside access path [Bug 2964715]} -setup { + set i [safe::interpCreate] + set testdir [file join [temporaryDirectory] deletethisdir] + set testdir2 [file join $testdir deletemetoo] + set testfile [file join $testdir2 deleteme.tm] + file mkdir $testdir2 + mkfile $testfile +} -body { + $i eval glob -directory $testdir2 *.tm +} -returnCodes error -cleanup { + safe::interpDelete $i + file delete -force $testdir +} -result {permission denied} +test safe-13.4 {another valid glob call [Bug 2964715]} -setup { + set i [safe::interpCreate] + set testdir [file join [temporaryDirectory] deletethisdir] + set testdir2 [file join $testdir deletemetoo] + set testfile [file join $testdir2 deleteme.tm] + file mkdir $testdir2 + mkfile $testfile +} -body { + ::safe::interpAddToAccessPath $i $testdir + ::safe::interpAddToAccessPath $i $testdir2 + set result [$i eval \ + glob -nocomplain -directory $testdir [file join deletemetoo *.tm]] + if {$result eq [list $testfile]} { + return "glob match" + } else { + return "no match: $result" + } +} -cleanup { + safe::interpDelete $i + file delete -force $testdir +} -result {glob match} +test safe-13.5 {as 13.4 but test glob failure when -directory is outside access path [Bug 2964715]} -setup { + set i [safe::interpCreate] + set testdir [file join [temporaryDirectory] deletethisdir] + set testdir2 [file join $testdir deletemetoo] + set testfile [file join $testdir2 deleteme.tm] + file mkdir $testdir2 + mkfile $testfile +} -body { + ::safe::interpAddToAccessPath $i $testdir2 + $i eval \ + glob -directory $testdir [file join deletemetoo *.tm] +} -returnCodes error -cleanup { + safe::interpDelete $i + file delete -force $testdir +} -result {permission denied} +test safe-13.6 {as 13.4 but test silent failure when result is outside access_path [Bug 2964715]} -setup { + set i [safe::interpCreate] + set testdir [file join [temporaryDirectory] deletethisdir] + set testdir2 [file join $testdir deletemetoo] + set testfile [file join $testdir2 deleteme.tm] + file mkdir $testdir2 + mkfile $testfile +} -body { + ::safe::interpAddToAccessPath $i $testdir + $i eval \ + glob -nocomplain -directory $testdir [file join deletemetoo *.tm] +} -cleanup { + safe::interpDelete $i + file delete -force $testdir +} -result {} +test safe-13.7 {mimic the glob call by tclPkgUnknown which gives a deliberate error in a safe interpreter [Bug 2964715]} -setup { + set i [safe::interpCreate] + set testdir [file join [temporaryDirectory] deletethisdir] + set testdir2 [file join $testdir deletemetoo] + set testfile [file join $testdir2 pkgIndex.tcl] + file mkdir $testdir2 + mkfile $testfile +} -body { + set safeTD [::safe::interpAddToAccessPath $i $testdir] + ::safe::interpAddToAccessPath $i $testdir2 + string map [list $safeTD EXPECTED] [$i eval [list \ + glob -directory $safeTD -join * pkgIndex.tcl]] +} -cleanup { + safe::interpDelete $i + file delete -force $testdir +} -result {{EXPECTED/deletemetoo/pkgIndex.tcl}} +# Note the extra {} around the result above; that's *expected* because of the +# format of virtual path roots. +test safe-13.8 {mimic the glob call by tclPkgUnknown without the deliberate error that is specific to pkgIndex.tcl [Bug 2964715]} -setup { + set i [safe::interpCreate] + set testdir [file join [temporaryDirectory] deletethisdir] + set testdir2 [file join $testdir deletemetoo] + set testfile [file join $testdir2 notIndex.tcl] + file mkdir $testdir2 + mkfile $testfile +} -body { + set safeTD [::safe::interpAddToAccessPath $i $testdir] + ::safe::interpAddToAccessPath $i $testdir2 + $i eval [list glob -directory $safeTD -join -nocomplain * notIndex.tcl] +} -cleanup { + safe::interpDelete $i + file delete -force $testdir +} -result {} +test safe-13.9 {as 13.8 but test glob failure when -directory is outside access path [Bug 2964715]} -setup { + set i [safe::interpCreate] + set testdir [file join [temporaryDirectory] deletethisdir] + set testdir2 [file join $testdir deletemetoo] + set testfile [file join $testdir2 notIndex.tcl] + file mkdir $testdir2 + mkfile $testfile +} -body { + ::safe::interpAddToAccessPath $i $testdir2 + set result [$i eval \ + glob -directory $testdir -join -nocomplain * notIndex.tcl] + if {$result eq [list $testfile]} { + return {glob match} + } else { + return "no match: $result" + } +} -cleanup { + safe::interpDelete $i + file delete -force $testdir +} -result {no match: } +test safe-13.10 {as 13.8 but test silent failure when result is outside access_path [Bug 2964715]} -setup { + set i [safe::interpCreate] + set testdir [file join [temporaryDirectory] deletethisdir] + set testdir2 [file join $testdir deletemetoo] + set testfile [file join $testdir2 notIndex.tcl] + file mkdir $testdir2 + mkfile $testfile +} -body { + ::safe::interpAddToAccessPath $i $testdir + $i eval glob -directory $testdir -join -nocomplain * notIndex.tcl +} -cleanup { + safe::interpDelete $i + file delete -force $testdir +} -result {} +rename mkfile {} + +#### Test for the module path +test safe-14.1 {Check that module path is the same as in the master interpreter [Bug 2964715]} -setup { + set i [safe::interpCreate] +} -body { + set tm {} + foreach token [$i eval ::tcl::tm::path list] { + lappend tm [dict get [set ::safe::S${i}(access_path,map)] $token] + } + return $tm +} -cleanup { + safe::interpDelete $i +} -result [::tcl::tm::path list] + set ::auto_path $saveAutoPath # cleanup ::tcltest::cleanupTests diff --git a/tests/switch.test b/tests/switch.test index 5ee7216..f04f636 100644 --- a/tests/switch.test +++ b/tests/switch.test @@ -536,7 +536,7 @@ test switch-11.6 {-matchvar unwritable} { test switch-12.1 {regexp matching with -indexvar} { switch -regexp -indexvar x -- abc {.(.). {set x}} -} {{0 3} {1 2}} +} {{0 2} {1 1}} test switch-12.2 {regexp matching with -indexvar} { set x GOOD switch -regexp -indexvar x -- abc {.(.).. {list $x z}} @@ -544,7 +544,7 @@ test switch-12.2 {regexp matching with -indexvar} { } GOOD test switch-12.3 {regexp matching with -indexvar} { switch -regexp -indexvar x -- "a b c" {.(.). {set x}} -} {{0 3} {1 2}} +} {{0 2} {1 1}} test switch-12.4 {regexp matching with -indexvar} { set x BAD switch -regexp -indexvar x -- "a b c" { @@ -560,22 +560,32 @@ test switch-12.6 {-indexvar unwritable} { set x {} list [catch {switch -regexp -indexvar x(x) -- abc . {set x}} msg] $x $msg } {1 {} {can't set "x(x)": variable isn't array}} +test switch-12.7 {[Bug 3106532] -indexvar should be directly usable with [string range]} { + set str abcdef + switch -regexp -indexvar x -- $str ^... {string range $str {*}[lindex $x 0]} +} abc +test switch-12.8 {-indexvar and matched empty strings} { + switch -regexp -indexvar x -- abcdef ^...(x?) {return $x} +} {{0 2} {3 2}} +test switch-12.9 {-indexvar and unmatched strings} { + switch -regexp -indexvar x -- abcdef ^...(x)? {return $x} +} {{0 2} {-1 -1}} test switch-13.1 {-indexvar -matchvar combinations} { switch -regexp -indexvar x -matchvar y abc { . {list $x $y} } -} {{{0 1}} a} +} {{{0 0}} a} test switch-13.2 {-indexvar -matchvar combinations} { switch -regexp -indexvar x -matchvar y abc { .$ {list $x $y} } -} {{{2 3}} c} +} {{{2 2}} c} test switch-13.3 {-indexvar -matchvar combinations} { switch -regexp -indexvar x -matchvar y abc { (.)(.)(.) {list $x $y} } -} {{{0 3} {0 1} {1 2} {2 3}} {abc a b c}} +} {{{0 2} {0 0} {1 1} {2 2}} {abc a b c}} test switch-13.4 {-indexvar -matchvar combinations} { set x - set y - @@ -597,7 +607,7 @@ test switch-13.6 {-indexvar -matchvar combinations} { list [catch { switch -regexp -indexvar x -matchvar y(y) abc {. {list $x $y}} } msg] $x $y $msg -} {1 {{0 1}} - {can't set "y(y)": variable isn't array}} +} {1 {{0 0}} - {can't set "y(y)": variable isn't array}} test switch-14.1 {-regexp -- compilation [Bug 1854399]} { switch -regexp -- 0 { diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl index a7b463c..b43423d 100644 --- a/tools/genStubs.tcl +++ b/tools/genStubs.tcl @@ -33,6 +33,22 @@ namespace eval genStubs { variable curName "UNKNOWN" + # scspec -- + # + # Storage class specifier for external function declarations. + # Normally "EXTERN", may be set to something like XYZAPI + # + variable scspec "EXTERN" + + # epoch, revision -- + # + # The epoch and revision numbers of the interface currently being defined. + # (@@@TODO: should be an array mapping interface names -> numbers) + # + + variable epoch {} + variable revision 0 + # hooks -- # # An array indexed by interface name that contains the set of @@ -94,6 +110,27 @@ proc genStubs::interface {name} { return } +# genStubs::scspec -- +# +# Define the storage class macro used for external function declarations. +# Typically, this will be a macro like XYZAPI or EXTERN that +# expands to either DLLIMPORT or DLLEXPORT, depending on whether +# -DBUILD_XYZ has been set. +# +proc genStubs::scspec {value} { + variable scspec $value +} + +# genStubs::epoch -- +# +# Define the epoch number for this library. The epoch +# should be incrememented when a release is made that +# contains incompatible changes to the public API. +# +proc genStubs::epoch {value} { + variable epoch $value +} + # genStubs::hooks -- # # This function defines the subinterface hooks for the current @@ -132,7 +169,9 @@ proc genStubs::hooks {names} { proc genStubs::declare {args} { variable stubs variable curName + variable revision + incr revision if {[llength $args] == 2} { lassign $args index decl set platformList generic @@ -246,14 +285,14 @@ proc genStubs::addPlatformGuard {plat iftxt {eltxt {}}} { set text "" switch $plat { win { - append text "#ifdef __WIN32__ /* WIN */\n${iftxt}" + append text "#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */\n${iftxt}" if {$eltxt ne ""} { append text "#else /* WIN */\n${eltxt}" } append text "#endif /* WIN */\n" } unix { - append text "#if !defined(__WIN32__) && !defined(MAC_OSX_TCL)\ + append text "#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL)\ /* UNIX */\n${iftxt}" if {$eltxt ne ""} { append text "#else /* UNIX */\n${eltxt}" @@ -275,7 +314,7 @@ proc genStubs::addPlatformGuard {plat iftxt {eltxt {}}} { append text "#endif /* AQUA */\n" } x11 { - append text "#if !(defined(__WIN32__) || defined(MAC_OSX_TK))\ + append text "#if !(defined(__WIN32__) || defined(__CYGWIN__) || defined(MAC_OSX_TK))\ /* X11 */\n${iftxt}" if {$eltxt ne ""} { append text "#else /* X11 */\n${eltxt}" @@ -407,13 +446,14 @@ proc genStubs::parseArg {arg} { # Returns the formatted declaration string. proc genStubs::makeDecl {name decl index} { + variable scspec lassign $decl rtype fname args append text "/* $index */\n" if {$rtype != "void"} { regsub -all void $rtype VOID rtype } - set line "EXTERN $rtype" + set line "$scspec $rtype" set count [expr {2 - ([string length $line] / 8)}] append line [string range "\t\t\t" 0 $count] set pad [expr {24 - [string length $line]}] @@ -421,6 +461,12 @@ proc genStubs::makeDecl {name decl index} { append line " " set pad 0 } + if {$args eq ""} { + append line $fname + append text $line + append text ";\n" + return $text + } if {$args == ""} { append line $fname append text $line @@ -536,8 +582,8 @@ proc genStubs::makeSlot {name decl index} { append text $rtype " *" $lfname "; /* $index */\n" return $text } - if {[string range $rtype end-7 end] == "CALLBACK"} { - append text [string trim [string range $rtype 0 end-8]] " (CALLBACK *" $lfname ") " + if {[string range $rtype end-8 end] == "__stdcall"} { + append text [string trim [string range $rtype 0 end-9]] " (__stdcall *" $lfname ") " } else { append text $rtype " (*" $lfname ") " } @@ -926,10 +972,19 @@ proc genStubs::emitMacros {name textVar} { proc genStubs::emitHeader {name} { variable outDir variable hooks + variable epoch + variable revision set capName [string toupper [string index $name 0]] append capName [string range $name 1 end] + if {$epoch != ""} { + set CAPName [string toupper $name] + append text "\n" + append text "#define ${CAPName}_STUBS_EPOCH $epoch\n" + append text "#define ${CAPName}_STUBS_REVISION $revision\n" + } + emitDeclarations $name text if {[info exists hooks($name)]} { @@ -943,6 +998,10 @@ proc genStubs::emitHeader {name} { } append text "\ntypedef struct ${capName}Stubs {\n" append text " int magic;\n" + if {$epoch != ""} { + append text " int epoch;\n" + append text " int revision;\n" + } append text " struct ${capName}StubHooks *hooks;\n\n" emitSlots $name text @@ -972,6 +1031,7 @@ proc genStubs::emitHeader {name} { proc genStubs::emitInit {name textVar} { variable hooks + variable epoch upvar $textVar text set capName [string toupper [string index $name 0]] @@ -988,6 +1048,11 @@ proc genStubs::emitInit {name textVar} { } append text "\n${capName}Stubs ${name}Stubs = \{\n" append text " TCL_STUB_MAGIC,\n" + if {$epoch != ""} { + set CAPName [string toupper $name] + append text " ${CAPName}_STUBS_EPOCH,\n" + append text " ${CAPName}_STUBS_REVISION,\n" + } if {[info exists hooks($name)]} { append text " &${name}StubHooks,\n" } else { diff --git a/unix/Makefile.in b/unix/Makefile.in index c88736c..883a379 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -47,6 +47,7 @@ BIN_INSTALL_DIR = $(INSTALL_ROOT)$(bindir) # Directory in which to install libtcl.so or libtcl.a: LIB_INSTALL_DIR = $(INSTALL_ROOT)$(libdir) +DLL_INSTALL_DIR = @DLL_INSTALL_DIR@ # Path name to use when installing library scripts. SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TCL_LIBRARY) @@ -719,9 +720,9 @@ install-binaries: binaries @if test ! -x $(SRC_DIR)/../unix/install-sh; then \ chmod +x $(SRC_DIR)/../unix/install-sh; \ fi - @echo "Installing $(LIB_FILE) to $(LIB_INSTALL_DIR)/" + @echo "Installing $(LIB_FILE) to $(DLL_INSTALL_DIR)/" @@INSTALL_LIB@ - @chmod 555 "$(LIB_INSTALL_DIR)"/$(LIB_FILE) + @chmod 555 "$(DLL_INSTALL_DIR)"/$(LIB_FILE) @echo "Installing ${TCL_EXE} as $(BIN_INSTALL_DIR)/tclsh$(VERSION)@EXEEXT@" @$(INSTALL_PROGRAM) ${TCL_EXE} "$(BIN_INSTALL_DIR)"/tclsh$(VERSION)@EXEEXT@ @echo "Installing tclConfig.sh to $(CONFIG_INSTALL_DIR)/" diff --git a/unix/configure b/unix/configure index 67ae68b..4b141b6 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 RANLIB ac_ct_RANLIB AR ac_ct_AR 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 INSTALL_STUB_LIB CFLAGS_DEFAULT LDFLAGS_DEFAULT LIBOBJS DTRACE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_YEAR 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 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 RANLIB ac_ct_RANLIB AR ac_ct_AR 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 LIBOBJS DTRACE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_YEAR 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 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. @@ -8961,12 +8961,23 @@ fi UNSHARED_LIB_SUFFIX='${VERSION}.a' fi + DLL_INSTALL_DIR="\$(LIB_INSTALL_DIR)" 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}' - INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)"/$(LIB_FILE)' + if test "${SHLIB_SUFFIX}" = ".dll"; then + + 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)' + +fi + else @@ -9122,6 +9133,7 @@ _ACEOF + echo "$as_me:$LINENO: checking for build with symbols" >&5 echo $ECHO_N "checking for build with symbols... $ECHO_C" >&6 # Check whether --enable-symbols or --disable-symbols was given. @@ -18893,6 +18905,81 @@ _ACEOF fi #-------------------------------------------------------------------- +# The check below checks whether the cpuid instruction is usable. +#-------------------------------------------------------------------- + +echo "$as_me:$LINENO: checking whether the cpuid instruction is usable" >&5 +echo $ECHO_N "checking whether the cpuid instruction is usable... $ECHO_C" >&6 +if test "${tcl_cv_cpuid+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. */ + +int +main () +{ + + int index,regsPtr[4]; + __asm__ __volatile__("mov %%ebx, %%edi \n\t" + "cpuid \n\t" + "mov %%ebx, %%esi \n\t" + "mov %%edi, %%ebx \n\t" + : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3]) + : "a"(index) : "edi"); + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + tcl_cv_cpuid=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_cpuid=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $tcl_cv_cpuid" >&5 +echo "${ECHO_T}$tcl_cv_cpuid" >&6 +if test $tcl_cv_cpuid = yes; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_CPUID 1 +_ACEOF + +fi + +#-------------------------------------------------------------------- # The statements below define a collection of symbols related to # building libtcl as a shared library instead of a static library. #-------------------------------------------------------------------- @@ -19802,6 +19889,7 @@ s,@SHLIB_SUFFIX@,$SHLIB_SUFFIX,;t t s,@MAKE_LIB@,$MAKE_LIB,;t t s,@MAKE_STUB_LIB@,$MAKE_STUB_LIB,;t t s,@INSTALL_LIB@,$INSTALL_LIB,;t t +s,@DLL_INSTALL_DIR@,$DLL_INSTALL_DIR,;t t s,@INSTALL_STUB_LIB@,$INSTALL_STUB_LIB,;t t s,@CFLAGS_DEFAULT@,$CFLAGS_DEFAULT,;t t s,@LDFLAGS_DEFAULT@,$LDFLAGS_DEFAULT,;t t diff --git a/unix/configure.in b/unix/configure.in index b3df242..441c98f 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -726,6 +726,24 @@ elif test $tcl_cv_stack_grows_up = yes; then fi #-------------------------------------------------------------------- +# The check below checks whether the cpuid instruction is usable. +#-------------------------------------------------------------------- + +AC_CACHE_CHECK([whether the cpuid instruction is usable], tcl_cv_cpuid, [ + AC_TRY_LINK(, [ + int index,regsPtr[4]; + __asm__ __volatile__("mov %%ebx, %%edi \n\t" + "cpuid \n\t" + "mov %%ebx, %%esi \n\t" + "mov %%edi, %%ebx \n\t" + : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3]) + : "a"(index) : "edi"); + ], tcl_cv_cpuid=yes, tcl_cv_cpuid=no)]) +if test $tcl_cv_cpuid = yes; then + AC_DEFINE(HAVE_CPUID, 1, [Is the cpuid instruction usable?]) +fi + +#-------------------------------------------------------------------- # The statements below define a collection of symbols related to # building libtcl as a shared library instead of a static library. #-------------------------------------------------------------------- diff --git a/unix/tcl.m4 b/unix/tcl.m4 index 4ccb37e..4e0ac62 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -2093,11 +2093,17 @@ dnl # preprocessing tests use only CPPFLAGS. SHARED_LIB_SUFFIX='${VERSION}${SHLIB_SUFFIX}']) AS_IF([test "$UNSHARED_LIB_SUFFIX" = ""], [ UNSHARED_LIB_SUFFIX='${VERSION}.a']) + DLL_INSTALL_DIR="\$(LIB_INSTALL_DIR)" 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}' - INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)"/$(LIB_FILE)' + AS_IF([test "${SHLIB_SUFFIX}" = ".dll"], [ + 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)' + ]) ], [ LIB_SUFFIX=${UNSHARED_LIB_SUFFIX} @@ -2178,6 +2184,7 @@ dnl # preprocessing tests use only CPPFLAGS. AC_SUBST(MAKE_LIB) AC_SUBST(MAKE_STUB_LIB) AC_SUBST(INSTALL_LIB) + AC_SUBST(DLL_INSTALL_DIR) AC_SUBST(INSTALL_STUB_LIB) AC_SUBST(RANLIB) ]) diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c index b9c64b1..dac782b 100644 --- a/unix/tclAppInit.c +++ b/unix/tclAppInit.c @@ -26,8 +26,8 @@ extern Tcl_PackageInitProc Tcltest_Init; #endif /* TCL_TEST */ #ifdef TCL_XT_TEST -extern void XtToolkitInitialize _ANSI_ARGS_((void)); -extern int Tclxttest_Init _ANSI_ARGS_((Tcl_Interp *interp)); +extern void XtToolkitInitialize (void); +extern int Tclxttest_Init (Tcl_Interp *interp); #endif /* @@ -62,7 +62,7 @@ main( #ifndef TCL_LOCAL_APPINIT #define TCL_LOCAL_APPINIT Tcl_AppInit #endif - extern int TCL_LOCAL_APPINIT _ANSI_ARGS_((Tcl_Interp *interp)); + extern int TCL_LOCAL_APPINIT (Tcl_Interp *interp); /* * The following #if block allows you to change how Tcl finds the startup @@ -71,7 +71,7 @@ main( */ #ifdef TCL_LOCAL_MAIN_HOOK - extern int TCL_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, char ***argv)); + extern int TCL_LOCAL_MAIN_HOOK (int *argc, char ***argv); #endif #ifdef TCL_XT_TEST diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index 53c5c47..93bb1fe 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -1063,7 +1063,7 @@ TtyGetOptionProc( # define TtyGetBaud(speed) ((int) (speed)) #else /* !DIRECT_BAUD */ -static struct {int baud; unsigned long speed;} speeds[] = { +static CONST struct {int baud; unsigned long speed;} speeds[] = { #ifdef B0 {0, B0}, #endif diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c index 782d70c..f582c0c 100644 --- a/unix/tclUnixCompat.c +++ b/unix/tclUnixCompat.c @@ -803,8 +803,7 @@ CopyString( * Get CPU ID information on an Intel box under UNIX (either Linux or Cygwin) * * Results: - * Returns TCL_OK if successful, TCL_ERROR if CPUID is not supported or - * fails. + * Returns TCL_OK if successful, TCL_ERROR if CPUID is not supported. * * Side effects: * If successful, stores EAX, EBX, ECX and EDX registers after the CPUID @@ -820,7 +819,16 @@ TclWinCPUID( { int status = TCL_ERROR; - /* There is no reason this couldn't be implemented on UNIX as well */ + /* See: <http://en.wikipedia.org/wiki/CPUID> */ +#if defined(HAVE_CPUID) + __asm__ __volatile__("mov %%ebx, %%edi \n\t" /* save %ebx */ + "cpuid \n\t" + "mov %%ebx, %%esi \n\t" /* save what cpuid just put in %ebx */ + "mov %%edi, %%ebx \n\t" /* restore the old %ebx */ + : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3]) + : "a"(index) : "edi"); + status = TCL_OK; +#endif return status; } diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index 7d82d1d..edd0d2f 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -22,7 +22,8 @@ static int NativeMatchType(Tcl_Interp *interp, CONST char* nativeEntry, * TclpFindExecutable -- * * This function computes the absolute path name of the current - * application, given its argv[0] value. + * application, given its argv[0] value. For Cygwin, argv[0] is + * ignored and the path is determined the same as under win32. * * Results: * None. @@ -38,10 +39,26 @@ TclpFindExecutable( CONST char *argv0) /* The value of the application's argv[0] * (native). */ { - CONST char *name, *p; + Tcl_Encoding encoding; +#ifdef __CYGWIN__ + int length; + char buf[PATH_MAX * TCL_UTF_MAX + 1]; + 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); + 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); +#else + const char *name, *p; Tcl_StatBuf statBuf; Tcl_DString buffer, nameString, cwd, utfName; - Tcl_Encoding encoding; if (argv0 == NULL) { return; @@ -174,6 +191,7 @@ TclpFindExecutable( done: Tcl_DStringFree(&buffer); +#endif } /* diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h index 82fc8bb..8684757 100644 --- a/unix/tclUnixPort.h +++ b/unix/tclUnixPort.h @@ -74,8 +74,32 @@ typedef off_t Tcl_SeekOffset; #endif #ifdef __CYGWIN__ -MODULE_SCOPE int TclOSstat(const char *name, Tcl_StatBuf *statBuf); -MODULE_SCOPE int TclOSlstat(const char *name, Tcl_StatBuf *statBuf); + + /* Make some symbols available without including <windows.h> */ +# define DWORD unsigned int +# define CP_UTF8 65001 +# define GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS 0x00000004 +# define HANDLE void * +# define HINSTANCE void * +# define SOCKET unsigned int +# define WSAEWOULDBLOCK 10035 + DLLIMPORT extern __stdcall int GetModuleHandleExW(unsigned int, const char *, void *); + DLLIMPORT extern __stdcall int GetModuleFileNameW(void *, const char *, int); + DLLIMPORT extern __stdcall int WideCharToMultiByte(int, int, const char *, int, + const char *, int, const char *, const char *); + + DLLIMPORT extern int cygwin_conv_to_full_posix_path(const char *, char *); +# 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) # define TclOSstat stat64 # define TclOSlstat lstat64 @@ -259,8 +283,8 @@ MODULE_SCOPE int TclUnixSetBlockingMode(int fd, int mode); #endif #ifdef GETTOD_NOT_DECLARED -EXTERN int gettimeofday _ANSI_ARGS_((struct timeval *tp, - struct timezone *tzp)); +EXTERN int gettimeofday (struct timeval *tp, + struct timezone *tzp); #endif /* @@ -584,7 +608,6 @@ typedef int socklen_t; * address platform-specific issues. */ -#define TclpGetPid(pid) ((unsigned long) (pid)) #define TclpReleaseFile(file) /* Nothing. */ /* @@ -603,9 +626,8 @@ typedef int socklen_t; #define TclpExit exit #ifdef TCL_THREADS -EXTERN struct tm * TclpLocaltime(CONST time_t *); -EXTERN struct tm * TclpGmtime(CONST time_t *); -EXTERN char * TclpInetNtoa(struct in_addr); +EXTERN struct tm *TclpLocaltime(CONST time_t *); +EXTERN struct tm *TclpGmtime(CONST time_t *); /* #define localtime(x) TclpLocaltime(x) * #define gmtime(x) TclpGmtime(x) */ # undef inet_ntoa @@ -624,7 +646,7 @@ EXTERN char * TclpInetNtoa(struct in_addr); # ifdef HAVE_PTHREAD_GETATTR_NP # define TclpPthreadGetAttrs pthread_getattr_np # ifdef GETATTRNP_NOT_DECLARED -EXTERN int pthread_getattr_np _ANSI_ARGS_((pthread_t, pthread_attr_t *)); +EXTERN int pthread_getattr_np (pthread_t, pthread_attr_t *); # endif # endif /* HAVE_PTHREAD_GETATTR_NP */ # endif /* HAVE_PTHREAD_ATTR_GET_NP */ diff --git a/win/Makefile.in b/win/Makefile.in index d3c9c80..1b7d21f 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -558,7 +558,7 @@ install-binaries: binaries else true; \ fi; \ done; - @for i in dde1.3 reg1.2; \ + @for i in dde$(DDEDOTVER) reg$(REGDOTVER); \ do \ if [ ! -d $(LIB_INSTALL_DIR)/$$i ] ; then \ echo "Making directory $(LIB_INSTALL_DIR)/$$i"; \ @@ -582,23 +582,23 @@ install-binaries: binaries done @if [ -f $(DDE_DLL_FILE) ]; then \ echo installing $(DDE_DLL_FILE); \ - $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde1.3; \ + $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde$(DDEDOTVER); \ $(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \ - $(LIB_INSTALL_DIR)/dde1.3; \ + $(LIB_INSTALL_DIR)/dde$(DDEDOTVER); \ fi @if [ -f $(DDE_LIB_FILE) ]; then \ echo installing $(DDE_LIB_FILE); \ - $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde1.3; \ + $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde$(DDEDOTVER); \ fi @if [ -f $(REG_DLL_FILE) ]; then \ echo installing $(REG_DLL_FILE); \ - $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg1.2; \ + $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg$(REGDOTVER); \ $(COPY) $(ROOT_DIR)/library/reg/pkgIndex.tcl \ - $(LIB_INSTALL_DIR)/reg1.2; \ + $(LIB_INSTALL_DIR)/reg$(REGDOTVER); \ fi @if [ -f $(REG_LIB_FILE) ]; then \ echo installing $(REG_LIB_FILE); \ - $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg1.2; \ + $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg$(REGDOTVER); \ fi install-libraries: libraries install-tzdata install-msgs diff --git a/win/configure b/win/configure index fd09f73..b74dd39 100755 --- a/win/configure +++ b/win/configure @@ -309,7 +309,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 CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP AR ac_ct_AR RANLIB ac_ct_RANLIB RC ac_ct_RC SET_MAKE TCL_THREADS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL 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_DLL_FILE TCL_SRC_DIR TCL_BIN_DIR TCL_DBGX CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX EXTRA_CFLAGS DEPARG CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX TCL_SHARED_BUILD LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TCL_BUILD_LIB_SPEC TCL_LD_SEARCH_FLAGS TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_PACKAGE_PATH TCL_DDE_VERSION TCL_DDE_MAJOR_VERSION TCL_DDE_MINOR_VERSION TCL_DDE_PATCH_LEVEL TCL_REG_VERSION TCL_REG_MAJOR_VERSION TCL_REG_MINOR_VERSION TCL_REG_PATCH_LEVEL RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES RES LIBOBJS LTLIBOBJS' +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 CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP AR ac_ct_AR RANLIB ac_ct_RANLIB RC ac_ct_RC SET_MAKE TCL_THREADS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL 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_DLL_FILE TCL_SRC_DIR TCL_BIN_DIR TCL_DBGX CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX EXTRA_CFLAGS DEPARG CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX TCL_SHARED_BUILD LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TCL_BUILD_LIB_SPEC TCL_LD_SEARCH_FLAGS TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_PACKAGE_PATH TCL_DDE_VERSION TCL_DDE_MAJOR_VERSION TCL_DDE_MINOR_VERSION TCL_REG_VERSION TCL_REG_MAJOR_VERSION TCL_REG_MINOR_VERSION RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES RES LIBOBJS LTLIBOBJS' ac_subst_files='' # Initialize some variables set by options. @@ -1317,13 +1317,11 @@ VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.3 TCL_DDE_MAJOR_VERSION=1 TCL_DDE_MINOR_VERSION=3 -TCL_DDE_PATCH_LEVEL="2" DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION TCL_REG_VERSION=1.2 TCL_REG_MAJOR_VERSION=1 TCL_REG_MINOR_VERSION=2 -TCL_REG_PATCH_LEVEL="1" REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION #------------------------------------------------------------------------ @@ -4909,8 +4907,6 @@ fi - - ac_config_files="$ac_config_files Makefile tclConfig.sh tcl.hpj" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure @@ -5630,11 +5626,9 @@ s,@TCL_PACKAGE_PATH@,$TCL_PACKAGE_PATH,;t t s,@TCL_DDE_VERSION@,$TCL_DDE_VERSION,;t t s,@TCL_DDE_MAJOR_VERSION@,$TCL_DDE_MAJOR_VERSION,;t t s,@TCL_DDE_MINOR_VERSION@,$TCL_DDE_MINOR_VERSION,;t t -s,@TCL_DDE_PATCH_LEVEL@,$TCL_DDE_PATCH_LEVEL,;t t s,@TCL_REG_VERSION@,$TCL_REG_VERSION,;t t s,@TCL_REG_MAJOR_VERSION@,$TCL_REG_MAJOR_VERSION,;t t s,@TCL_REG_MINOR_VERSION@,$TCL_REG_MINOR_VERSION,;t t -s,@TCL_REG_PATCH_LEVEL@,$TCL_REG_PATCH_LEVEL,;t t s,@RC_OUT@,$RC_OUT,;t t s,@RC_TYPE@,$RC_TYPE,;t t s,@RC_INCLUDE@,$RC_INCLUDE,;t t diff --git a/win/configure.in b/win/configure.in index dd1f745..955ba29 100644 --- a/win/configure.in +++ b/win/configure.in @@ -20,13 +20,11 @@ VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.3 TCL_DDE_MAJOR_VERSION=1 TCL_DDE_MINOR_VERSION=3 -TCL_DDE_PATCH_LEVEL="2" DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION TCL_REG_VERSION=1.2 TCL_REG_MAJOR_VERSION=1 TCL_REG_MINOR_VERSION=2 -TCL_REG_PATCH_LEVEL="1" REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION #------------------------------------------------------------------------ @@ -325,11 +323,9 @@ AC_SUBST(TCL_PACKAGE_PATH) AC_SUBST(TCL_DDE_VERSION) AC_SUBST(TCL_DDE_MAJOR_VERSION) AC_SUBST(TCL_DDE_MINOR_VERSION) -AC_SUBST(TCL_DDE_PATCH_LEVEL) AC_SUBST(TCL_REG_VERSION) AC_SUBST(TCL_REG_MAJOR_VERSION) AC_SUBST(TCL_REG_MINOR_VERSION) -AC_SUBST(TCL_REG_PATCH_LEVEL) AC_SUBST(RC) AC_SUBST(RC_OUT) diff --git a/win/tclAppInit.c b/win/tclAppInit.c index 289a3c3..0edd2c3 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -59,7 +59,7 @@ main( #ifndef TCL_LOCAL_APPINIT #define TCL_LOCAL_APPINIT Tcl_AppInit #endif - extern int TCL_LOCAL_APPINIT _ANSI_ARGS_((Tcl_Interp *interp)); + extern int TCL_LOCAL_APPINIT (Tcl_Interp *interp); /* * The following #if block allows you to change how Tcl finds the startup @@ -68,7 +68,7 @@ main( */ #ifdef TCL_LOCAL_MAIN_HOOK - extern int TCL_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, char ***argv)); + extern int TCL_LOCAL_MAIN_HOOK (int *argc, char ***argv); #endif char *p; diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 9f39b37..7e20da7 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -78,7 +78,7 @@ static DWORD ddeInstance; /* The application instance handle given to us * by DdeInitialize. */ static int ddeIsServer = 0; -#define TCL_DDE_VERSION "1.3.2" +#define TCL_DDE_VERSION "1.3.3" #define TCL_DDE_PACKAGE_NAME "dde" #define TCL_DDE_SERVICE_NAME "TclEval" #define TCL_DDE_EXECUTE_RESULT "$TCLEVAL$EXECUTE$RESULT" @@ -92,10 +92,11 @@ TCL_DECLARE_MUTEX(ddeMutex) static LRESULT CALLBACK DdeClientWindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam); static int DdeCreateClient(struct DdeEnumServices *es); -static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget, LPARAM lParam); +static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget, + LPARAM lParam); static void DdeExitProc(ClientData clientData); static int DdeGetServicesList(Tcl_Interp *interp, - char *serviceName, char *topicName); + const char *serviceName, const char *topicName); static HDDEDATA CALLBACK DdeServerProc(UINT uType, UINT uFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem, HDDEDATA hData, DWORD dwData1, DWORD dwData2); @@ -104,13 +105,12 @@ static LRESULT DdeServicesOnAck(HWND hwnd, WPARAM wParam, static void DeleteProc(ClientData clientData); static Tcl_Obj * ExecuteRemoteObject(RegisteredInterp *riPtr, Tcl_Obj *ddeObjectPtr); -static int MakeDdeConnection(Tcl_Interp *interp, char *name, - HCONV *ddeConvPtr); +static int MakeDdeConnection(Tcl_Interp *interp, + const char *name, HCONV *ddeConvPtr); static void SetDdeError(Tcl_Interp *interp); - -int Tcl_DdeObjCmd(ClientData clientData, +static int DdeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); EXTERN int Dde_Init(Tcl_Interp *interp); EXTERN int Dde_SafeInit(Tcl_Interp *interp); @@ -135,11 +135,11 @@ int Dde_Init( Tcl_Interp *interp) { - if (!Tcl_InitStubs(interp, "8.0", 0)) { + if (!Tcl_InitStubs(interp, "8.1", 0)) { return TCL_ERROR; } - Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL); Tcl_CreateExitHandler(DdeExitProc, NULL); return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION); } @@ -259,10 +259,10 @@ Initialize(void) *---------------------------------------------------------------------- */ -static char * +static const char * DdeSetServerName( Tcl_Interp *interp, - char *name, /* The name that will be used to refer to the + const char *name, /* The name that will be used to refer to the * interpreter in later "send" commands. Must * be globally unique. */ int exactName, /* Should we make a unique name? 0 = unique */ @@ -272,7 +272,7 @@ DdeSetServerName( int suffix, offset; RegisteredInterp *riPtr, *prevPtr; Tcl_DString dString; - char *actualName; + const char *actualName; Tcl_Obj *srvListPtr = NULL, **srvPtrPtr = NULL; int n, srvCount = 0, lastSuffix, r = TCL_OK; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -394,7 +394,7 @@ DdeSetServerName( Tcl_ExposeCommand(interp, "dde", "dde"); } - Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd, + Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, (ClientData) riPtr, DeleteProc); if (Tcl_IsSafe(interp)) { Tcl_HideCommand(interp, "dde", "dde"); @@ -468,7 +468,7 @@ DeleteProc( ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); for (searchPtr = tsdPtr->interpListPtr, prevPtr = NULL; - searchPtr != NULL && searchPtr != riPtr; + (searchPtr != NULL) && (searchPtr != riPtr); prevPtr = searchPtr, searchPtr = searchPtr->nextPtr) { /* * Empty loop body. @@ -534,7 +534,8 @@ ExecuteRemoteObject( Tcl_Obj *cmdPtr = Tcl_DuplicateObj(riPtr->handlerPtr); - result = Tcl_ListObjAppendElement(riPtr->interp, cmdPtr, ddeObjectPtr); + result = Tcl_ListObjAppendElement(riPtr->interp, cmdPtr, + ddeObjectPtr); if (result == TCL_OK) { ddeObjectPtr = cmdPtr; } @@ -546,7 +547,8 @@ ExecuteRemoteObject( returnPackagePtr = Tcl_NewListObj(0, NULL); - Tcl_ListObjAppendElement(NULL, returnPackagePtr, Tcl_NewIntObj(result)); + Tcl_ListObjAppendElement(NULL, returnPackagePtr, + Tcl_NewIntObj(result)); Tcl_ListObjAppendElement(NULL, returnPackagePtr, Tcl_GetObjResult(riPtr->interp)); @@ -589,7 +591,7 @@ static HDDEDATA CALLBACK DdeServerProc( UINT uType, /* The type of DDE transaction we are * performing. */ - UINT uFmt, /* The format that data is sent or received. */ + UINT uFmt, /* The format that data is sent or received */ HCONV hConv, /* The conversation associated with the * current transaction. */ HSZ ddeTopic, HSZ ddeItem, /* String handles. Transaction-type @@ -692,7 +694,7 @@ DdeServerProc( * execute. */ - if (uFmt != CF_TEXT) { + if ((uFmt != CF_TEXT) && (uFmt != CF_UNICODETEXT)) { return (HDDEDATA) FALSE; } @@ -705,7 +707,7 @@ DdeServerProc( } if (convPtr != NULL) { - BYTE *returnString; + char *returnString; len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINANSI); Tcl_DStringInit(&dString); @@ -714,10 +716,16 @@ DdeServerProc( DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1, CP_WINANSI); if (stricmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { - returnString = (BYTE *) - Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len); - ddeReturn = DdeCreateDataHandle(ddeInstance, returnString, - (DWORD) len+1, 0, ddeItem, CF_TEXT, 0); + if (uFmt == CF_TEXT) { + returnString = + Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len); + } else { + returnString = (char *) + Tcl_GetUnicodeFromObj(convPtr->returnPackagePtr, &len); + len = 2 * len + 1; + } + ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString, + (DWORD) len+1, 0, ddeItem, uFmt, 0); } else { if (Tcl_IsSafe(convPtr->riPtr->interp)) { ddeReturn = NULL; @@ -726,11 +734,17 @@ DdeServerProc( convPtr->riPtr->interp, utilString, NULL, TCL_GLOBAL_ONLY); if (variableObjPtr != NULL) { - returnString = (BYTE *) Tcl_GetStringFromObj( - variableObjPtr, &len); + if (uFmt == CF_TEXT) { + returnString = Tcl_GetStringFromObj( + variableObjPtr, &len); + } else { + returnString = (char *) Tcl_GetUnicodeFromObj( + variableObjPtr, &len); + len = 2 * len + 1; + } ddeReturn = DdeCreateDataHandle(ddeInstance, - returnString, (DWORD) len+1, 0, ddeItem, - CF_TEXT, 0); + (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, + uFmt, 0); } else { ddeReturn = NULL; } @@ -761,7 +775,10 @@ DdeServerProc( utilString = (char *) DdeAccessData(hData, &dlen); len = dlen; - ddeObjectPtr = Tcl_NewStringObj(utilString, -1); + if (len && !utilString[len-1]) { + len--; + } + ddeObjectPtr = Tcl_NewStringObj(utilString, len); Tcl_IncrRefCount(ddeObjectPtr); DdeUnaccessData(hData); if (convPtr->returnPackagePtr != NULL) { @@ -873,14 +890,14 @@ DdeExitProc( static int MakeDdeConnection( Tcl_Interp *interp, /* Used to report errors. */ - char *name, /* The connection to use. */ + const char *name, /* The connection to use. */ HCONV *ddeConvPtr) { HSZ ddeTopic, ddeService; HCONV ddeConv; ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, 0); - ddeTopic = DdeCreateStringHandle(ddeInstance, (void *) name, 0); + ddeTopic = DdeCreateStringHandle(ddeInstance, name, 0); ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); @@ -959,7 +976,7 @@ DdeClientWindowProc( #ifdef _WIN64 SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR) es); #else - SetWindowLong(hwnd, GWL_USERDATA, (long)es); + SetWindowLong(hwnd, GWL_USERDATA, (LONG) es); #endif return (LRESULT) 0L; } @@ -994,9 +1011,9 @@ DdeServicesOnAck( Tcl_Obj *matchPtr = Tcl_NewListObj(0, NULL); Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp); - GlobalGetAtomNameA(service, sz, 255); + GlobalGetAtomName(service, sz, 255); Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1)); - GlobalGetAtomNameA(topic, sz, 255); + GlobalGetAtomName(topic, sz, 255); Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1)); /* @@ -1044,8 +1061,8 @@ DdeEnumWindowsCallback( static int DdeGetServicesList( Tcl_Interp *interp, - char *serviceName, - char *topicName) + const char *serviceName, + const char *topicName) { struct DdeEnumServices es; @@ -1092,7 +1109,7 @@ static void SetDdeError( Tcl_Interp *interp) /* The interp to put the message in. */ { - char *errorMessage; + const char *errorMessage; switch (DdeGetLastError(ddeInstance)) { case DMLERR_DATAACKTIMEOUT: @@ -1116,7 +1133,7 @@ SetDdeError( /* *---------------------------------------------------------------------- * - * Tcl_DdeObjCmd -- + * DdeObjCmd -- * * This function is invoked to process the "dde" Tcl command. See the * user documentation for details on what it does. @@ -1130,31 +1147,30 @@ SetDdeError( *---------------------------------------------------------------------- */ -int -Tcl_DdeObjCmd( +static int +DdeObjCmd( ClientData clientData, /* Used only for deletion */ Tcl_Interp *interp, /* The interp we are sending from */ int objc, /* Number of arguments */ - Tcl_Obj *CONST * objv) /* The arguments */ + Tcl_Obj *const *objv) /* The arguments */ { - static CONST char *ddeCommands[] = { + static const char *ddeCommands[] = { "servername", "execute", "poke", "request", "services", "eval", - (char *) NULL - }; + (char *) NULL}; enum DdeSubcommands { DDE_SERVERNAME, DDE_EXECUTE, DDE_POKE, DDE_REQUEST, DDE_SERVICES, DDE_EVAL }; - static CONST char *ddeSrvOptions[] = { + static const char *ddeSrvOptions[] = { "-force", "-handler", "--", NULL }; enum DdeSrvOptions { DDE_SERVERNAME_EXACT, DDE_SERVERNAME_HANDLER, DDE_SERVERNAME_LAST, }; - static CONST char *ddeExecOptions[] = { + static const char *ddeExecOptions[] = { "-async", NULL }; - static CONST char *ddeReqOptions[] = { + static const char *ddeReqOptions[] = { "-binary", NULL }; @@ -1164,7 +1180,7 @@ Tcl_DdeObjCmd( HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL; HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn; HCONV hConv = NULL; - char *serviceName = NULL, *topicName = NULL, *string; + const char *serviceName = NULL, *topicName = NULL, *string; DWORD ddeResult; Tcl_Obj *objPtr, *handlerPtr = NULL; @@ -1290,8 +1306,8 @@ Tcl_DdeObjCmd( int dummy; firstArg = 2; - if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", 0, - &dummy) == TCL_OK) { + if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", + 0, &dummy) == TCL_OK) { if (objc < 5) { goto wrongDdeEvalArgs; } @@ -1329,7 +1345,8 @@ Tcl_DdeObjCmd( switch ((enum DdeSubcommands) index) { case DDE_SERVERNAME: - serviceName = DdeSetServerName(interp, serviceName, exact, handlerPtr); + serviceName = DdeSetServerName(interp, serviceName, exact, + handlerPtr); if (serviceName != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj(serviceName, -1)); } else { @@ -1381,7 +1398,8 @@ Tcl_DdeObjCmd( break; } case DDE_REQUEST: { - char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length); + const char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], + &length); if (length == 0) { Tcl_SetObjResult(interp, @@ -1408,13 +1426,17 @@ Tcl_DdeObjCmd( result = TCL_ERROR; } else { DWORD tmp; - const BYTE *dataString = DdeAccessData(ddeData, &tmp); + const char *dataString = (const char *) DdeAccessData(ddeData, &tmp); if (binary) { - returnObjPtr = Tcl_NewByteArrayObj(dataString, + returnObjPtr = Tcl_NewByteArrayObj((BYTE *) dataString, (int) tmp); } else { - returnObjPtr = Tcl_NewStringObj((const char *)dataString, -1); + if (tmp && !dataString[tmp-1]) { + --tmp; + } + returnObjPtr = Tcl_NewStringObj(dataString, + (int) tmp); } DdeUnaccessData(ddeData); DdeFreeDataHandle(ddeData); @@ -1429,7 +1451,8 @@ Tcl_DdeObjCmd( break; } case DDE_POKE: { - char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length); + const char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], + &length); BYTE *dataString; if (length == 0) { diff --git a/win/tclWinError.c b/win/tclWinError.c index d3126b1..a74d2e2 100644 --- a/win/tclWinError.c +++ b/win/tclWinError.c @@ -333,11 +333,6 @@ static CONST int wsaErrorTable[] = { EREMOTE /* WSAEREMOTE */ }; -#ifdef __CYGWIN__ -# include <windows.h> -# define DWORD unsigned int -#endif - /* *---------------------------------------------------------------------- * diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index a1338a7..d918b4a 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -50,7 +50,7 @@ enum { WIN_SYSTEM_ATTRIBUTE }; -static int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN, +static const int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN, 0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM}; diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index b29dde4..b1affe3 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -869,7 +869,7 @@ TclpCloseFile( *-------------------------------------------------------------------------- */ -unsigned long +int TclpGetPid( Tcl_Pid pid) /* The HANDLE of the child process. */ { @@ -1369,7 +1369,7 @@ ApplicationType( Tcl_DString nameBuf, ds; const TCHAR *nativeName; WCHAR nativeFullPath[MAX_PATH]; - static char extensions[][5] = {"", ".com", ".exe", ".bat"}; + static const char extensions[][5] = {"", ".com", ".exe", ".bat"}; /* * Look for the program as an external program. First try the name as it diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 8eaf2a7..f2ac367 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -52,7 +52,7 @@ static CONST char *rootKeyNames[] = { "HKEY_PERFORMANCE_DATA", "HKEY_DYN_DATA", NULL }; -static HKEY rootKeys[] = { +static const HKEY rootKeys[] = { HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, HKEY_DYN_DATA }; diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 019d8e9..9591163 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -1129,7 +1129,7 @@ CreateSocketAddress( ZeroMemory(sockaddrPtr, sizeof(SOCKADDR_IN)); sockaddrPtr->sin_family = AF_INET; - sockaddrPtr->sin_port = htons((u_short) (port & 0xFFFF)); + sockaddrPtr->sin_port = htons((unsigned short) (port & 0xFFFF)); if (host == NULL) { addr.s_addr = INADDR_ANY; } else { @@ -2512,9 +2512,25 @@ TclWinSetSockOpt(SOCKET s, int level, int optname, const char *optval, return setsockopt(s, level, optname, optval, optlen); } -u_short -TclWinNToHS( - u_short netshort) +unsigned short +TclWinNToHS(unsigned short netshort) +{ + /* + * Check that WinSock is initialized; do not call it if not, to + * prevent system crashes. This can happen at exit time if the exit + * handler for WinSock ran before other exit handlers that want to + * use sockets. + */ + + if (!SocketsEnabled()) { + return (unsigned short) -1; + } + + return ntohs(netshort); +} + +char * +TclpInetNtoa(struct in_addr addr) { /* * Check that WinSock is initialized; do not call it if not, to prevent @@ -2523,10 +2539,10 @@ TclWinNToHS( */ if (!SocketsEnabled()) { - return (u_short) -1; + return NULL; } - return ntohs(netshort); + return inet_ntoa(addr); } struct servent * diff --git a/win/tclWinTest.c b/win/tclWinTest.c index d0bbb09..e493fbf 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -40,8 +40,6 @@ static int TestwinclockCmd(ClientData dummy, Tcl_Interp* interp, static int TestwinsleepCmd(ClientData dummy, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]); static Tcl_ObjCmdProc TestExceptionCmd; -static int TestwincpuidCmd(ClientData dummy, Tcl_Interp* interp, - int objc, Tcl_Obj *const objv[]); static int TestplatformChmod(const char *nativePath, int pmode); static int TestchmodCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); @@ -76,7 +74,6 @@ TclplatformtestInit( Tcl_CreateObjCommand(interp, "testvolumetype", TestvolumetypeCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testwincpuid", TestwincpuidCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd, NULL, NULL); return TCL_OK; @@ -292,83 +289,6 @@ TestwinclockCmd( return TCL_OK; } -/* - *---------------------------------------------------------------------- - * - * TestwincpuidCmd -- - * - * Retrieves CPU ID information. - * - * Usage: - * testwincpuid <eax> - * - * Parameters: - * eax - The value to pass in the EAX register to a CPUID instruction. - * - * Results: - * Returns a four-element list containing the values from the EAX, EBX, - * ECX and EDX registers returned from the CPUID instruction. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -TestwincpuidCmd( - ClientData dummy, - Tcl_Interp* interp, /* Tcl interpreter */ - int objc, /* Parameter count */ - Tcl_Obj *const * objv) /* Parameter vector */ -{ - int status, index, i; - unsigned int regs[4]; - Tcl_Obj *regsObjs[4]; - - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "eax"); - return TCL_ERROR; - } - if (Tcl_GetIntFromObj(interp, objv[1], &index) != TCL_OK) { - return TCL_ERROR; - } - status = TclWinCPUID((unsigned) index, regs); - if (status != TCL_OK) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("operation not available", -1)); - return status; - } - for (i=0 ; i<4 ; ++i) { - regsObjs[i] = Tcl_NewIntObj((int) regs[i]); - } - Tcl_SetObjResult(interp, Tcl_NewListObj(4, regsObjs)); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TestwinsleepCmd -- - * - * Causes this process to wait for the given number of milliseconds by - * means of a direct call to Sleep. - * - * Usage: - * testwinsleep <n> - * - * Parameters: - * n - the number of milliseconds to sleep - * - * Results: - * None. - * - * Side effects: - * Sleeps for the requisite number of milliseconds. - * - *---------------------------------------------------------------------- - */ - static int TestwinsleepCmd( ClientData clientData, /* Unused */ @@ -428,7 +348,7 @@ TestExceptionCmd( "invalid_disp", "guard_page", "invalid_handle", "ctrl+c", NULL }; - static DWORD exceptions[] = { + static const DWORD exceptions[] = { EXCEPTION_ACCESS_VIOLATION, EXCEPTION_DATATYPE_MISALIGNMENT, EXCEPTION_ARRAY_BOUNDS_EXCEEDED, EXCEPTION_FLT_DENORMAL_OPERAND, EXCEPTION_FLT_DIVIDE_BY_ZERO, EXCEPTION_FLT_INEXACT_RESULT, diff --git a/win/tclWinTime.c b/win/tclWinTime.c index 3ae108b..f34884a 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -27,11 +27,11 @@ * month, where index 1 is January. */ -static int normalDays[] = { +static const int normalDays[] = { -1, 30, 58, 89, 119, 150, 180, 211, 242, 272, 303, 333, 364 }; -static int leapDays[] = { +static const int leapDays[] = { -1, 30, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 }; @@ -734,7 +734,7 @@ ComputeGMT( struct tm *tmPtr; long tmp, rem; int isLeap; - int *days; + const int *days; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); tmPtr = &tsdPtr->tm; |